home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 1.iso / ARGONET / PD / EDITORS / FAMILYTREE.SPK / !Family / !RunImSrc (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1996-10-29  |  84KB  |  3,332 lines
  1.  This program is Copyright 1993, 1996 Denis Howe.  You may
  2.  distribute verbatim or modified copies of this program
  3.  provided each such copy is distributed with a copyright
  4.  notice and distribution conditions identical to these.
  5.  Please send me a copy of any changes you make and
  6.  update the modification history at the end of !Help.
  7.  Denis Howe <dbh@doc.ic.ac.uk>
  8. Task$    = "Family"
  9. #Purpose$ = "Family tree editor"
  10. "Author$  = "
  11.  1993 Denis Howe"
  12. #Version$ = "2.15 (17 Oct 1996)"
  13.  Initialise some variables for PROCError & PROCQuit
  14. :Task%=0:Modified%=
  15. :Font%=0:ExtEdJob%=0
  16. Error:
  17.  ================== User-customisable variables ===================
  18.  Maximum completions to show in Comp window
  19. MaxComp%=25
  20.  Maximum spouses in divorce menu
  21. MaxSpouse%=10
  22.  Maximum depth of tree displayed
  23. MaxGen%=20
  24.  Maximum GEDCOM structure depth
  25. MaxLevel%=20
  26. MTLoad("<Family$Dir>.Messages")
  27.  Allocate the heap by lowering HIMEM below the WimpSlot,
  28.  making sure there are VarSize% bytes left above
  29.  END for further variables, DIMs and strings.
  30. (.VarSize%=40000:Heap%=
  31. +VarSize%:HeapEnd%=
  32.  Heap%>=HeapEnd% 
  33. MT("NR")
  34. =Heap%                   :
  35.  Can't do this in a PROC
  36. +7Heap%=
  37.                    :
  38.  Read back actual value
  39. Init                      :
  40.  Misc one-off initialisation
  41. CrMenu                    :
  42.  Create menus
  43. InitTags                  :
  44.  Set up GEDCOM tags structures
  45.  PROCSyntax                :REM Load GEDCOM syntax description
  46. Reset                     :
  47.  Reset heap and database
  48. Args                      :
  49.  Check for cmd line args
  50.  ========================== Main loop =============================
  51. Error            :
  52.  Falls back into poll loop
  53. CheckFree
  54. Modified
  55.  Force% 
  56. Force         :
  57.  Update display
  58.  "Wimp_Poll",&1831,b% 
  59. Redraw
  60.  "Wimp_OpenWindow",,b%
  61.  "Wimp_CloseWindow",,b%
  62. @.    
  63.  !b%=MainWH% 
  64. Close(NoteWH%):
  65. OpenDir
  66. DragDone
  67. Buttons(!b%,b%!4,b%!8,b%!12,b%!16)
  68. Key(!b%,b%!4,b%!24)
  69. MenuClick(b%!0,b%!4,b%!8,b%!12)
  70.  17,18:
  71. Receive(b%!0,b%!4,b%!8,b%!16)
  72. RcvAck(b%!0,b%!4,b%!16)
  73.  ===================== GEDCOM access functions ====================
  74.  Return an object's value after stripping the reference flag
  75. Val(O%)=O%!ObVal% 
  76.  ObRef%
  77.  Create a new object with Tag% and Value%
  78. Object(Tag%,Value%)
  79. Alloc(ObSize%)
  80. U=O%!ObTag%=Tag%:O%!ObVal%=Value%:O%!ObSubs%=0:O%!ObNext%=0
  81.  Convert null pointer to empty string
  82. Null(P%)
  83.  Return a string to print O%'s value - either
  84.  its string value or a cross-reference Id.
  85. PrintStr(O%)
  86.  V%:V%=O%!ObVal%
  87.  ObRef% 
  88. Id(V% 
  89.  ObRef%)
  90. Null(V%)
  91.  Get the string value of O%'s first sub-object
  92.  with Tag% or "" if there is no such value
  93. GetStr(O%,Tag%)=
  94. Null(
  95. GetVal(O%,Tag%))
  96.  Return the value of object O%'s first sub-object
  97.  with Tag% or 0 if there is no such object
  98. GetVal(O%,Tag%)
  99.  S%:S%=0
  100. GetSub(O%,Tag%,S%) S%=
  101. Val(S%)
  102.  If S%=0 return O%'s first sub-object
  103.  with Tag% else return the next one
  104. GetSub(O%,Tag%,
  105.  O%=0 
  106.  1,"FNGetSub"
  107.  S% S%=S%!ObNext% 
  108.  S%=O%!ObSubs%
  109.  S%!ObTag%=Tag% 
  110.   S%=S%!ObNext%
  111.  Ensure that O% has a sub-object with Tag% and Val$ or none
  112.  if Val$="".  If Single% then overwrite any exiting Tag% sub-
  113.  object otherwise add a new one.  Deallocate any previous value.
  114. SetStr(O%,Tag%,Val$,Single%)
  115.  O$,V%,S%
  116.  O%=0 
  117.  1,"PROCSetStr"
  118.  Val$="" 
  119. DelTag(O%,Tag%):
  120. GetSub(O%,Tag%,S%)
  121. 1  V%=S%!ObVal%:
  122.  (V% 
  123.  ObRef%)=0 
  124.  $V%=Val$ 
  125.  Single% 
  126. )    
  127. Free(V%):S%!ObVal%=
  128. String(Val$)
  129.     Modified%=
  130.         
  131. Tail(O%)=
  132. Object(Tag%,
  133. String(Val$))
  134. Modified%=
  135.  Ensure that O% has a sub-object with Tag% and Val%. 
  136.  Single% => overwrite any existing Tag% sub-object
  137.  else add a new one.  Don't deallocate referend of
  138.  any previous value (which may not be a pointer).
  139. SetSub(O%,Tag%,Val%,Single%)
  140.  O%=0 
  141.  1,"PROCSetSub"
  142. GetSub(O%,Tag%,S%)
  143.  S%!ObVal%=Val% 
  144.  Single% 
  145.  S%!ObVal%=Val%:Modified%=
  146. Tail(O%)=
  147. Object(Tag%,Val%)
  148. Modified%=
  149.  Return the address of the last ObNext% in P%'s sub-object list
  150. Tail(P%)
  151. )P%=P%+ObSubs%:
  152.  !P%:P%=!P%+ObNext%:
  153.  ======================= Remove, Delete, Kill =====================
  154.  Remove => unlink the object from some given place but don't free it.
  155.  Delete => remove it and free it and its string value.
  156.  Kill   => delete it and remove any cross-references to it.
  157.  Delete object Victim%, its sub-objects and all cross-references to
  158.  it from other objects.  Also remove objects which are only referred
  159.  to from Victim%.  These may be shared so we have to traverse the
  160.  whole database several times to determine what's still live.
  161. Kill(Victim%)
  162.  Victim%=0 
  163. Mark(Victim%)
  164. Scan(Root%):
  165. Modified%=
  166. :Force%=1
  167.  Mark object O% and its sub-objects by setting the
  168.  Dead% bit in their tag pointers (not their tag flags)
  169. Mark(O%)
  170. O%!ObTag%=O%!ObTag% 
  171.  Dead%
  172. 1O%=O%!ObSubs%:
  173. Mark(O%):O%=O%!ObNext%:
  174.  Mark as dead any sub-object of O% which is a cross-reference
  175.  to a dead object.  Recurse on its sub-objects.  If any
  176.  sub-object is marked as dead, free it and remove it from the 
  177.  list.  If a FAM object is left with less than 2 sub-objects
  178.  then remove it.  Return Dead% if any object died.
  179. Scan(O%)
  180.  D%,P%,S%,V%
  181. P%=O%+ObTag%:V%=O%!ObVal%
  182.  ObRef% 
  183.   V%=V% 
  184.  ObRef%
  185.  Dead x-ref - mark O% dead
  186.  V%!ObTag% 
  187.  Dead% !P%=!P% 
  188.  Dead%
  189.  D%=!P% 
  190.  Dead%:P%=O%+ObSubs%
  191.   S%=!P%:D%=D% 
  192. Scan(S%)
  193.  S%!ObTag% 
  194.  Dead% 
  195. FreeOb(S%)
  196.     !P%=S%!ObNext%
  197.  P%=S%+ObNext%
  198. P%=O%+ObTag%
  199.  (!P% 
  200.  Dead%)=FamTg% 
  201.   S%=O%!ObSubs%
  202.  S%!ObNext% 
  203.  !P%=!P% 
  204.  Dead%:D%=Dead%
  205.  Free object O% and its value (if a string) but not its sub-
  206.  objects.  If it's a display structure pointer, free the name.
  207. FreeOb(O%)
  208.  V%:V%=O%!ObVal%
  209.  (O%!ObTag% 
  210.  Dead%)=DispTg% 
  211. Free(V%!DSName%)
  212.  (V% 
  213.  ObRef%)=0 
  214. Free(V%)
  215. Free(O%)
  216.  Remove O%'s first sub-object with Tag% and Val% but don't free it
  217. RemSub(O%,Tag%,Val%)
  218.  O%=0 
  219.  Val%=0 
  220.  1,"PROCRemSub"
  221. P%=O%+ObSubs%
  222.   O%=!P%
  223.  O%!ObTag%=Tag% 
  224. 6    
  225. Val(O%)=Val% 
  226.  !P%=O%!ObNext%:Modified%=
  227.   P%=O%+ObNext%
  228.  Remove S% from O%'s sub-object list
  229. RemSubObj(O%,S%)
  230. O%=O%+ObSubs%
  231.  !O%=S% 
  232.  !O%=S%!ObNext%:
  233.   O%=!O%+ObNext%
  234.  Remove all O%'s sub-objects with Tag%
  235. DelTag(O%,Tag%)
  236.  O%=0 
  237.  1,"PROCDelTag"
  238. P%=O%+ObSubs%
  239.   O%=!P%
  240.  O%!ObTag%=Tag% 
  241. "    !P%=O%!ObNext%:
  242. DelObj(O%)
  243.     P%=O%+ObNext%
  244.  Remove object O% and its sub-objects
  245. DelObj(O%)
  246. FreeOb(O%)
  247. 3O%=O%!ObSubs%:
  248. DelObj(O%):O%=O%!ObNext%:
  249.  =========================== Display ==============================
  250.  Wimp requests redraw
  251. Redraw
  252.  XW%,YW%,M%,P%,WH%
  253.  "Wimp_RedrawWindow",,b% 
  254. $9WH%=!b%:XW%=b%!4-b%!20:YW%=b%!16-b%!24 :
  255.  Work origin
  256.  WH%=MainWH% 
  257.  TopChil%=0 
  258.  WH% 
  259.  MainWH%:
  260. Display(b%!28-XW%,b%!32-YW%,b%!36-XW%,b%!40-YW%,OutScreen%)
  261.  CompWH%:
  262. DrawComp(XW%,YW%)
  263.  NoteWH%:
  264. DrawNote(XW%,YW%)
  265.  ObEdWH%:
  266. DrawObEd(XW%,YW%,b%!32,b%!40)
  267.  1,"PROCRedraw"
  268.  "Wimp_GetRectangle",,b% 
  269.  Something in the main window has changed.
  270.  Recalculate all positions and the extent.
  271. Force
  272.  F%,O%,X%,Y%
  273. UseFont%=ScreenUseFont%
  274. CalcAll
  275. Close(MainWH%)
  276.  yMax%>yMin% 
  277. ;,  b%!0=(xMin%-32) 
  278.  7:b%!4=yMin% 
  279. <0  b%!8=(xMax%+7) 
  280.  7:b%!12=(yMax%+7) 
  281.  "Wimp_SetExtent",MainWH%,b%
  282. ?-b%!0=MainWH%:
  283.  "Wimp_GetWindowState",,b%
  284.  Force%>1 
  285.  TopChil%>0 
  286.  Find the Chil object pointing to Person%
  287.   F%=0:O%=0
  288. GetSub(Person%,FamcTg%,F%) 
  289.     F%=
  290. Val(F%):X%=0
  291. E.    
  292. GetSub(F%,ChilTg%,O%) X%=
  293. Val(O%)
  294.  O%=0 
  295.  X%=Person%
  296.  O%=0 O%=TopChil%
  297. GetPos(O%,X%,Y%)  :
  298.  Scroll to show Person%
  299.   b%!20=X%-(b%!12-b%!4) 
  300.   b%!24=Y%+(b%!16-b%!8) 
  301.  b%!8-=Infinity%:b%!12+=Infinity% :REM Max window down right
  302.  "Wimp_OpenWindow",,b%
  303. Force%=0
  304.  Ensure menu on top if open
  305.  Menu% 
  306.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  307.  Get the display position of a CHIL object.  A CHIL's 
  308.  first subobject always points to its display structure.
  309. GetPos(C%,
  310.  C%=0 
  311.  1,"PROCGetPos"
  312. C%=C%!ObSubs%
  313. C%=C%!ObVal%
  314. X%=C%!DSx%:Y%=C%!DSy%
  315. Name(P%)=
  316. GetStr(P%,NameTg%)
  317.  If N$ contains two '/'s return the string between them.
  318.  Otherwise return the last word preceded by a space or nothing if
  319.  no such word.  Ignore anything after a non-initial '(' or '['.
  320. FamName(N$)
  321.  B%,E%,S%
  322.  N$="" 
  323.  Check for GEDCOM family name between '/'s
  324. N$,"/")
  325.  S% S%+=1:E%=
  326. N$,"/",S%):
  327. N$,S%,E%-S%)
  328. j&B%=
  329. N$,"(",2):
  330.  B%=0 B%=
  331. N$,"[",2)
  332.  B% N$=
  333. N$,B%-1)
  334. N$,1)=" ":N$=
  335. (N$)-1):
  336. N$," "):
  337.  S% N$=
  338. N$,S%+1):B%=
  339.  S%=0
  340.  Return P%'s dates string.  Show "?" for missing d.o.b.
  341.  but nothing for death (would suggest person is dead).
  342. Dates(P%)
  343.  D$,W$
  344. Birth(P%)
  345.  D$>"" W$=
  346. Year(D$) 
  347.  W$="?"
  348. W$+=" -"
  349. Death(P%)
  350.  D$>"" W$+=" "+
  351. Year(D$)
  352.  Return date from last group of digits to end
  353. Year(D$)
  354.  ShowYearOnly% 
  355.  E%>1
  356. Digit(
  357. D$,E%,1)) 
  358. %    
  359.  E%-=1:
  360. Digit(
  361. D$,E%,1))
  362.     =
  363. D$,E%+1)
  364.   E%-=1
  365. Alpha(C$)
  366.  C%:C%=
  367. (C$) 
  368. =C%>=
  369.  C%<=
  370. Digit(C$)=C$>="0" 
  371.  C$<="9"
  372.  ===================== Calculate positions ========================
  373.  Calculate work coords of Person%'s family.
  374.  Set global work area (xMin%,yMin%) to (xMax%,yMax%).
  375.  Global UseFont% determines string widths.
  376. CalcAll
  377.  DS%,H%,I%,P%,S%,Y0%
  378.  "Font_SetFont",Font%      :
  379.  Affects widths
  380. HGap%=
  381. Width("XX")            :
  382.  Horiz. space between adjacent people
  383.  UseFont% 
  384.  "Font_ReadInfo",Font% 
  385. ,,Y0%,,H%:H%-=Y0% 
  386.  H%=CharH%
  387. LineHeight%=H%+8
  388. 1xMin%=0:yMin%=0:xMax%=MinW%:yMax%=0:xMax%()=0
  389.  Person%=0 TopChil%=0:
  390.  Error here (e.g. out of memory) is fatal
  391.  Fake a CHIL object to point to the person at the top of
  392.  the tree.  Attach the top level display structure to it.
  393. ,TopChil%=
  394. Object(ChilTg%,
  395. Fore(Person%))
  396. DStruct(TopChil%)
  397. S%=TopChil%:P%=0
  398.  S%>1
  399.  S%!ObTag% 
  400.  HusbTg%,WifeTg%,ChilTg%
  401. D    DS%=
  402. DStruct(S%)       :
  403.  Give every member a display struct
  404. 6    DS%!DSx%=Infinity%      :
  405.  Everyone off screen
  406.     DS%!DSy%=-Infinity%
  407.   S%=S%!ObNext%
  408.  S%=0
  409. 7    
  410. GetSub(Root%,FamTg%,P%) S%=P%!ObSubs% 
  411.  S%=1
  412.  "Hourglass_On"
  413. Calc(TopChil%,0,0,z,xMin%,xMax%)
  414.  "Hourglass_Off"
  415. Max(xMax%,MinW%)
  416. xMax%+=20
  417.  Calculate position of person pointed to by Chil%, his
  418.  spouses and descendants.  Y% is his top.  Return his
  419.  centre and left and right of everything below him.
  420. Calc(Chil%,Y%,Gen%,
  421.  XLT%,
  422.  XRT%)
  423.  DS%,Done%,I%,FO%,P%,SN%,W%,X1%,XF%,XR%,XLF%,XRF%,OxMax%(),N$
  424.  OxMax%(MaxGen%)
  425. Val(Chil%):
  426.  P%=0 
  427.  1,"PROCCalc"
  428. DS%=ObVal%!(Chil%!ObSubs%)
  429.  DS%!DSy%>Y% X%=xMax%(Gen%):XLT%=X%:XRT%=X%:
  430. DS%!DSy%=Y%-LineHeight%
  431. ShowName(P%,Gen%=0)
  432. Free(DS%!DSName%):DS%!DSName%=
  433. String(N$)
  434. Width(N$)
  435.  ShowDates% 
  436. Max(W%,
  437. Width(
  438. Dates(P%))):Y%-=LineHeight%
  439. #Y%-=4*LineHeight%:
  440.  W% W%+=Gap%
  441. Min(yMin%,Y%)
  442. FI%=0:FO%=0                    :
  443.  1st of >1 spouses is #1 else no #
  444. GetSub(P%,FamsTg%,FO%) 
  445. GetSub(P%,FamsTg%,FO%) I%=1
  446. DS%!DSSpNum%=I%
  447. OxMax%()=xMax%():Done%=
  448.  If no families place against border.
  449. @  X%=OxMax%(Gen%):XR%=X%+W%   :
  450.  P%'s borders if no families
  451.   XLT%=X%:XRT%=XR%
  452. =  X%+=W% 
  453.  2                :
  454.  P%'s centre if no families
  455.   X1%=0:XF%=X1%:FO%=0
  456. GetSub(P%,FamsTg%,FO%)
  457. 4    
  458. CalcFam(P%,
  459. Val(FO%),Y%,Gen%,XF%,XLF%,XRF%)
  460. '    
  461.  X1%=0 X1%=XF%:
  462. Min(XLT%,XLF%)
  463. Max(XRT%,XRF%)
  464.  X1% 
  465. 1    XF%=(X1%+XF%) 
  466.  2:Done%=XF%>=X% 
  467.  Done%
  468.  Done% 
  469. <      
  470.  If families to right of P%, centre over families
  471.       X%=XF%:XR%=XF%+W% 
  472.         
  473. H      
  474.  If P% to right of families, shift descendants' borders right
  475. "      xMax%()=OxMax%():X%-=XF%
  476. -      
  477.  I%=Gen% 
  478.  MaxGen%:xMax%(I%)+=X%:
  479.         
  480.  Done%
  481. Max(xMax%(Gen%),XR%)
  482. 1DS%!DSx%=X%:DS%!DSxmin%=XLT%:DS%!DSxmax%=XRT%
  483.  Calculate positions of Top%'s spouse in Fam% and
  484.  their kids.  Return centre of spouse and left
  485.  and right of spouse/kids.  Y% is top of kids.
  486. CalcFam(Top%,Fam%,Y%,Gen%,
  487.  XLT%,
  488.  XRT%)
  489.  Spouse%,CO%,Done%,DS%,I%,N$,W%,X1%,XC%,XR%,XLF%,XRF%,OxMax%()
  490.  OxMax%(MaxGen%)
  491. Spouse%=0
  492. GetSub(Fam%,HusbTg%,Spouse%) 
  493. Val(Spouse%)=Top% Spouse%=0:z=
  494. GetSub(Fam%,WifeTg%,Spouse%)
  495.  Spouse% N$=
  496. Name(
  497. Val(Spouse%))
  498. Width(N$)+Gap%
  499. OxMax%()=xMax%():Done%=
  500. 3  X%=xMax%(Gen%):XR%=X%+W%    :
  501.  Wife's borders
  502.   XLT%=X%:XRT%=XR%
  503. <  X%+=W% 
  504.  2                :
  505.  Centre of wife if no kids
  506.   X1%=0:CO%=0
  507.  Gen%<MaxGen% 
  508. $    
  509. GetSub(Fam%,ChilTg%,CO%)
  510. ,      
  511. Calc(CO%,Y%,Gen%+1,XC%,XLF%,XRF%)
  512. )      
  513.  X1%=0 X1%=XC%:
  514. Min(XLT%,XLF%)
  515.       
  516. Max(XRT%,XRF%)
  517.         
  518.  X1% 
  519. 1    XC%=(X1%+XC%) 
  520.  2       :
  521.  Centre of kids
  522.     Done%=XC%>=X% 
  523.  Done%
  524.  Done% 
  525. <      
  526.  If kids to right of wife - centre wife over kids
  527.       X%=XC%:XR%=X%+W% 
  528.         
  529. D      
  530.  Wife to right of kids - shift descendants' borders right
  531. "      xMax%()=OxMax%():X%-=XC%
  532. /      
  533.  I%=Gen%+1 
  534.  MaxGen%:xMax%(I%)+=X%:
  535.         
  536.                         :
  537.  No kids
  538.  Spouse%=0 X%=0
  539.  Done%
  540. xMax%(Gen%)=XR%
  541.  Spouse%=0 
  542. DDS%=ObVal%!(Spouse%!ObSubs%):DS%!DSx%=X%:DS%!DSy%=Y%+LineHeight%
  543. Free(DS%!DSName%):DS%!DSName%=
  544. String(N$)
  545. ShowName(P%,ShowFam%)
  546.  I%,J%,F$,G$,N$
  547.  P%=0 
  548.  1,"FNShowName"
  549. Name(P%)
  550.  ShowFamilyName% 
  551.  ShowFam% 
  552.  Hide family name if same as father's and father visible
  553. " F$=
  554. FamName(N$):
  555.  F$="" 
  556. Father(P%):
  557.  I%=0 
  558. $'G$=
  559. FamName(
  560. Name(I%)):
  561.  G$="" 
  562.  G$<>F$ 
  563. &'J%=0:
  564.  I%=J%:J%=
  565. N$,F$,I%+1):
  566.  J%=0
  567. '%J%=I%+
  568. (F$):
  569. N$,J%,1)="/" J%+=1
  570. N$,I%-2)+
  571. N$,J%)
  572. Width(S$)
  573.  UseFont% 
  574. =CharW%*
  575.  "Font_StringWidth",,S$,Infinity%,Infinity%,-1,Infinity% 
  576.  mPtPerOS%
  577.  ========================= Display tree ===========================
  578.  Display tree starting at person pointed to by TopChil% at pre-
  579.  calculated work coords.  xMin%..yMax% is visible work rectangle. 
  580.  Globals XW%,YW% contain the screen coords of the work area origin
  581.  which is added to work coords for plotting.  These routines
  582.  are used for screen display (OutputTo%=OutScreen%, printing
  583.  (OutputTo%=OutPrint%), and for making DrawFiles (OutputTo%=OutDraw%).
  584. Display(xMin%,yMin%,xMax%,yMax%,OutputTo%)
  585.  OutputTo%=OutPrint% 
  586. Colour(Black%)
  587. DisplayIndi(TopChil%,-LineHeight%,xMin%,yMin%-LineHeight%,xMax%,yMax%)
  588. DisplayIndi(Chil%,Y%,xMin%,yMin%,xMax%,yMax%)
  589.  CO%,DS%,F%,FO%,H%,P%,S%,SL%,SN%,SP%,SR%,XP%,YP%,X1%,XM%,N$
  590. Val(Chil%)
  591. ACDS%=ObVal%!(Chil%!ObSubs%)    :
  592.  First subobj is display struct
  593.  DS%!DSxmin%>=xMax% 
  594.  DS%!DSxmax%<=xMin% 
  595. XP%=DS%!DSx%:YP%=DS%!DSy%
  596.  YP%<=yMin% 
  597.  YP%<>Y% 
  598. G2Y%-=4*LineHeight%:
  599.  ShowDates% Y%-=LineHeight%
  600. H8SN%=DS%!DSSpNum%              :
  601.  1 => Number spouses
  602.  OutputTo%<>OutPrint% 
  603. SexColour(P%)
  604. Centre($(DS%!DSName%),XP%,YP%,
  605.  OutputTo%<>OutPrint% 
  606. Colour(Black%):FontCol%=Black%
  607.  ShowDates% 
  608. Centre(
  609. Dates(P%),XP%,YP%-LineHeight%,
  610. H%=LineHeight% 
  611.  2-4:FO%=0
  612. GetSub(P%,FamsTg%,FO%)
  613. O&  F%=
  614. Val(FO%):X1%=Infinity%:CO%=0
  615. GetSub(F%,ChilTg%,CO%)
  616. GetPos(CO%,XP%,YP%)
  617. R:    YP%+=YW%+LineHeight%      :
  618.  YP% now screen coords
  619.  OutputTo%=OutDraw% 
  620. T7      
  621. dw_line(XW%+XP%,YP%,XW%+XP%,YP%-H%,FontCol%)
  622. U        
  623. V:      
  624.  XW%+XP%,YP%:
  625.  BY 0,-H% :
  626.  Vertical above child
  627. W        
  628.  X1%=Infinity% X1%=XP%
  629. Y4    
  630. DisplayIndi(CO%,Y%,xMin%,yMin%,xMax%,yMax%)
  631.  X1%<>Infinity% 
  632. \C    XM%=(X1%+XP%) 
  633.  2                 :
  634.  Between first and last
  635.  OutputTo%=OutDraw% 
  636. ^4      
  637. dw_line(XW%+XM%,YP%,XW%+XM%,YP%+H%,Fore%)
  638. _1      
  639. dw_line(XW%+X1%,YP%,XW%+XP%,YP%,Fore%)
  640. `        
  641. a:      
  642.  XW%+XM%,YP%:
  643.  BY 0,H% :
  644.  Vertical below spouse
  645. b!      
  646.  Avoid 16-bit overflow
  647. cB      X1%+=XW%:
  648.  X1%<-10000 X1%=-10000 
  649.  X1%>10000 X1%=10000
  650. dB      XP%+=XW%:
  651.  XP%<-10000 XP%=-10000 
  652.  XP%>10000 XP%=10000
  653. e6      
  654.  X1%,YP%,XP%,YP%              :
  655.  Horizontal
  656. f        
  657.  Find other parent in P%'s FAMS F%
  658.   SR%=0
  659. GetSub(F%,HusbTg%,SR%) 
  660.     SP%=
  661. Val(SR%)
  662. l>    
  663.  SP%=P% SR%=0:
  664. GetSub(F%,WifeTg%,SR%) SP%=
  665. Val(SR%)
  666.   S%=
  667.  SR% 
  668. p9    SL%=0:
  669. Spouses(SP%,SL%)=0 
  670.  1,"PROCDisplayIndi"
  671. q-    DS%=ObVal%!(SR%!ObSubs%):XM%=DS%!DSx%
  672. r.    S%=
  673. Father(SP%):
  674.  S%=0 S%=
  675. Mother(SP%)
  676. s.    
  677.  OutputTo%<>OutPrint% 
  678. SexColour(SP%)
  679. t7    
  680. Centre($(DS%!DSName%),XM%,Y%+2*LineHeight%,S%)
  681. u>    
  682.  OutputTo%<>OutPrint% 
  683. Colour(Black%):FontCol%=Black%
  684. v:    S%=
  685. Spouses(SP%,SL%)     :
  686.  SP% has other spouses?
  687. x$  N$="=":
  688.  SN% N$+=
  689. (SN%):SN%+=1
  690. Centre(N$,XM%,Y%+3*LineHeight%,S%)
  691. Centre(S$,X%,Y%,Plus%)
  692.  W%:W%=
  693. Width(S$)>>1
  694. X%+=XW%-W%:Y%+=YW%
  695.  X%<-10000 X%=-10000 
  696.  X%>10000 X%=10000
  697.  UseFont% 
  698.  OutputTo%=OutDraw% 
  699.  Plus% S$+="
  700. +    
  701. dw_text(X%,Y%,PtSize%,FontCol%,S$)
  702.  Screen or printer
  703. -    
  704.  Plus% S$+=
  705. (11)+
  706. (16)+
  707. (0)+"+"
  708. =    
  709.  "Font_Paint",Font%,S$,&310,X%,Y%-LineHeight% 
  710.  X%,Y%+12:
  711.  Plus% 
  712.  BY 0,10:
  713.  Set the foreground colour and font for system
  714.  font, lines and outline fonts.  Fore% is &BBGGRR00.
  715. Colour(Fore%)
  716.  Set GCOL for system font and lines
  717.  "ColourTrans_SetGCOL",Fore%,,,0
  718.  "ColourTrans_SetGCOL",White%,,,1<<7 :
  719.  Background
  720.  Set font and font colours in case using outline fonts
  721.  "Font_SetFont",Font%
  722.  "ColourTrans_SetFontColours",Font%,White%,Fore%,14
  723. SexColour(P%)
  724. Sex(P%) 
  725.  "M" :
  726. Colour(Blue%):FontCol%=Blue%
  727.  "F" :
  728. Colour(Red%):FontCol%=Red%
  729. Colour(Green%):FontCol%=Green%
  730.  A%,B%)
  731.  B%<A% A%=B%
  732.  A%,B%)
  733.  B%>A% A%=B%
  734.  ============================= WIMP ===============================
  735.  Load a template and create the window.  The block is
  736.  loaded at b%+4 so it can be used for Wimp_OpenWindow.
  737. GetTem($mess%)
  738.  "Wimp_LoadTemplate",,b%+4,ind%,indend%,-1,mess% 
  739. ,,ind%
  740.  b%!(4+64)=Sprites%        :REM User sprite area
  741.  "Wimp_CreateWindow",,b%+4 
  742.  Open window on top
  743. Open(!b%)
  744.  "Wimp_GetWindowState",,b%
  745. %b%!28=-1:
  746.  "Wimp_OpenWindow",,b%
  747. Close(!b%)
  748.  "Wimp_CloseWindow",,b%
  749.  Set work area extent and visible area.  Top left is work origin.
  750.  Bring window to front if Front%.
  751. Extent(WH%,Width%,Height%,Front%)
  752.  Depth%
  753.  Front% Depth%=-1 
  754.  !b%=WH%:
  755.  "Wimp_GetWindowState",,b%:Depth%=b%!28
  756. Close(WH%)                :
  757.  Force redraw
  758. ;b%!0=0:b%!4=-Height% 
  759.  7:b%!8=(Width%+7)
  760.  7:b%!12=0
  761.  "Wimp_SetExtent",WH%,b%
  762.  Resize visible area bottom right to work area
  763. =!b%=WH%:b%!12=b%!4+Width%:b%!8=b%!16-Height%:b%!28=Depth%
  764.  "Wimp_OpenWindow",,b%
  765.  Redraw icon given window and icon handles and selection state
  766. SelIcon(b%!0,b%!4,On%)
  767. %b%!8=(1<<21) 
  768.  On%<>0:b%!12=1<<21
  769.  "Wimp_SetIconState",,b%
  770.  Is icon selected?
  771. SelIcon(b%!0,b%!4)
  772.  "Wimp_GetIconState",,b%
  773. =(b%!24 
  774.  1<<21)<>0
  775.  Return the address of the indirected text of WH's icon IH.
  776.  Also the address of an indirected sprite.
  777. IcTxt(b%!0,b%!4) :
  778.  WH, IH
  779.  "Wimp_GetIconState",,b%
  780. =b%!28
  781. Caret(WH%,IH%,End%)
  782.  End% L%=
  783. IcTxt(WH%,IH%)) 
  784.  L%=0
  785.  "Wimp_SetCaretPosition",WH%,IH%,,,-1,L%
  786. SelIcon(WH%,IH%,
  787. )    :
  788.  Redraw icon
  789. Key(WH%,IH%,Key%)
  790.  Key% 
  791.  Print%:
  792. Print
  793.  F1%   :
  794. Complete(WH%,IH%)
  795.  F3%   :
  796. MouseMenu(SaveWH%)          :
  797.  F3 Save
  798.  F5%   :
  799. MouseMenu(GotoWH%)          :
  800.  F5 Goto
  801.  CtrlC%:
  802. EditChild(Person%)          :
  803.  ^C adds child
  804.  CtrlE%:
  805. EditPerson(Person%)         :
  806.  ^E edits current
  807.  CtrlS%:
  808.  WH%=EditWH% 
  809. Edit(0,Key%) :
  810.  ^S toggles sex
  811.  Return passed as key event.  Note any K command in the validation
  812.  string prevents CR being passed.  Kt only passes it for the last icon.
  813.  CR%,UpArrow%,DownArrow%:
  814.  WH%>0 
  815. Buttons(0,0,Key%,WH%,IH%)
  816.  Tab%  :
  817. Key(WH%,IH%,DownArrow%)
  818.  ShfTab%:
  819. Key(WH%,IH%,UpArrow%)
  820.  CtrlQ%:
  821.  "Wimp_ProcessKey",Key%
  822.  Mouse event @ X,Y or key press
  823. Buttons(X%,Y%,But%,WH%,IH%)
  824.  But%=2 
  825.  WH%<0 
  826.  IH%<0 
  827. OpenMenu(X%,Y%,WH%):
  828.  WH% 
  829.  -2                       :
  830.  Icon bar
  831.  Person% 
  832. Open(NoteWH%)
  833. Open(MainWH%)
  834.  CompWH%:
  835. Comp(Y%)
  836.  EditWH%:
  837. Edit(IH%,But%)
  838.  GotoWH%,MarryWH%
  839.  IH%=GoIcOK%,But%=CR%
  840. (    P%=
  841. Find($
  842. IcTxt(WH%,GoIcName%))
  843. :      
  844.  WH%=GotoWH% 
  845. Goto(P%) 
  846. Marry(MenuPerson%,P%)
  847.         
  848.  IH%=GoIcCur%
  849. -    $
  850. IcTxt(WH%,GoIcName%)=
  851. Name(Person%)
  852. Caret(WH%,GoIcName%,
  853.         
  854.  IH%=GoIcCan%:But%=4
  855.  MainWH%
  856.   P%=
  857. Near(X%,Y%):
  858.  P%=0 
  859.  But%=1 
  860. EditPerson(P%) 
  861. Goto(P%)
  862.  ModsWH%
  863.  IH% 
  864.  MoIcDisc%
  865.     Modified%=
  866.  ToDo$ 
  867.  ".Q":
  868.  ".R":
  869. Reset
  870. Load(ToDo$,
  871. "        
  872.  MoIcSave%:
  873. MouseMenu(SaveWH%):
  874.   But%=4
  875.  NoteWH%:
  876. EditNotes
  877.  SaveWH%,RepoWH%,DrawWH%:
  878. Save(WH%,IH%,But%)
  879.  ObEdWH%:
  880. ObEdClick(Y%)
  881.  WH% 
  882.  GotoWH%,InfoWH%,MarryWH%,ModsWH%
  883.  But%<>1 
  884. Close(WH%):
  885.  "Wimp_CreateMenu",,-1:Menu%=0
  886.  Open a filer window on the directory of TreeFile$
  887.  if it includes one and the ADJUST botton is pressed.
  888. OpenDir
  889.  I%,P%,D$
  890.  "Wimp_GetPointerInfo",,b%:
  891.  b%!8<>1 
  892. I%=1:P%=0
  893. TreeFile$,".",I%+1):
  894.  I% P%=I%
  895.  I%=0
  896.  P%=0 
  897. TreeFile$,P%-1)
  898. ;2b%!20=0:b%!24=0:
  899. Send(OpenDir,D$,17,b%,0,0,28)
  900. GetVar(Var$)
  901.  Len%
  902.  "XOS_ReadVarVal",Var$,b%,blen% 
  903. ,,Len%
  904. b%?Len%=CR%:=$b%
  905.  Return the zero-terminated string at S% as a Basic string
  906. GetZStr(S%)
  907.  P%:P%=S%
  908.  ?P%:P%+=1:
  909. $P%=""
  910.  ========================= Initialisation =========================
  911. D("")
  912. O4Infinity%=999999              :
  913.  Well off screen
  914. PFCharW%=16:CharH%=32           :
  915.  System character size in OS units
  916. QGMinW%=600                     :
  917.  Min width of main window work area
  918. R6Hash%=0                       :
  919.  No hash table yet
  920. Modified%=
  921. T5ModifiedShown%=
  922.  Modified%  :
  923.  Force title redraw
  924. U7LF%=10:CR%=13:CtrlC%=3:CtrlE%=5:CtrlQ%=17:CtrlS%=19
  925. V%Space%=
  926. " ":LPar%=
  927. "(":LBra%=
  928. W*Print%=&180:F1%=&181:F3%=&183:F5%=&185
  929. X+Tab%=&18A:DownArrow%=&18E:UpArrow%=&18F
  930. ShfTab%=&19A
  931. Z CR4$=
  932.  CR%+
  933.  CR%+
  934.  CR%+
  935.  Palette entries &BBGGRR00
  936. ];Black%=0:White%=&FFFFFF00     :
  937.  foreground, background
  938. ^3Red%=&0000FF00:Green%=&00FF0000:Blue%=&FF000000
  939.  WIMP Messages
  940. Quit=0
  941. b@DataSave=1:DataSaveAck=2:DataLoad=3:DataLoadAck=4:DataOpen=5
  942. c:PreQuit=8:OpenDir=&400:HelpRequest=&502:HelpReply=&503
  943. MenusDeleted=&400C9
  944.  External edit messages
  945. g2EditRq=&45D80:EditAck=&45D81:EditReturn=&45D82
  946. h(EditAbort=&45D83:EditDataSave=&45D84
  947. ExtEdJob%=0
  948. blen%=2048:messlen%=400
  949.  b% blen%:
  950.  ind% 2600,indend% -1,mess% messlen%
  951. m9$b%="TASK":
  952.  "Wimp_Initialise",200,!b%,Task$ 
  953. ,Task%
  954.  Files and filetypes
  955.  "OS_FSControl",31,"GEDCOM" 
  956. ,,TreeType%
  957.  "OS_FSControl",31,"Text" 
  958. ,,TextType%
  959.  "OS_FSControl",31,"DrawFile" 
  960. ,,DrawType%
  961. t"ReportType%=TextType% 
  962.  &10000
  963. SaveType%=0
  964. TreeLeaf$="Tree"
  965. NoteLeaf$="Notes"
  966. x4NoteFile$=
  967. GetVar("Wimp$ScrapDir")+"."+NoteLeaf$
  968. ReportLeaf$="Report"
  969. DrawLeaf$="DrawFile"
  970. Scrap$="<Wimp$Scrap>"
  971. |#OptFile$="<Family$Dir>.Choices"
  972. LoadOpts
  973.  Load sprites into user sprite area used by FNGetTem
  974.  LOCAL SpriteFile$
  975.  SpriteFile$="<Family$Dir>.Sprites"
  976.  Len%=FNFileLen(SpriteFile$)+4 :REM Add room for sprite area size.
  977.  DIM Sprites% Len%
  978.  Sprites%!0=Len%:Sprites%!8=16
  979.  SYS "OS_SpriteOp",256+9,Sprites%              :REM Init area.
  980.  SYS "OS_SpriteOp",256+10,Sprites%,SpriteFile$ :REM Load.
  981.  Create windows
  982.  "Wimp_OpenTemplate",,"<Family$Dir>.Templates"
  983. CompWH%=
  984. GetTem("Comp")
  985. A$(b%+76)="GEDCOM Edit":
  986.  "Wimp_CreateWindow",,b%+4 
  987.  ObEdWH%
  988. EditWH%=
  989. GetTem("Edit")
  990. CEdIcName%=0:EdIcBorn%=1:EdIcDied%=2:EdIcFather%=3:EdIcMother%=4
  991. 2EdIcMale%=5:EdIcFemale%=6:EdIcCan%=7:EdIcOK%=8
  992. GGotoWH%=
  993. GetTem("Goto"):GoIcName%=0:GoIcCan%=1:GoIcCur%=2:GoIcOK%=3
  994. @$(b%+4+72)=
  995. MT("MT"):
  996.  "Wimp_CreateWindow",,b%+4 
  997.  MarryWH%
  998. InfoWH%=
  999. GetTem("Info")
  1000. $b%!(4+88+20)=Task$
  1001. $b%!(4+88+32+20)=Purpose$
  1002. $b%!(4+88+64+20)=Author$
  1003. $b%!(4+88+96+20)=Version$
  1004. MainWH%=
  1005. GetTem("Main")
  1006. >ModsWH%=
  1007. GetTem("Mods"):MoIcDisc%=0:MoIcCan%=1:MoIcSave%=2
  1008. ,NoteWH%=
  1009. GetTem("Note"):NoteTitle%=b%!76
  1010. SaveWH%=
  1011. GetTem("Save")
  1012. 2SaIcFile%=0:SaIcSprite%=1:SaIcOK%=2:SaIcCan%=3
  1013. RepoWH%=
  1014. GetTem("Repo")
  1015. DrawWH%=
  1016. GetTem("Draw")
  1017.  "Wimp_CloseTemplate"
  1018. Open(MainWH%)
  1019.  BarIcText% 10,BarIcValid% 20
  1020. b%!0=-1:b%!4=0:b%!8=0
  1021. %b%!12=68:b%!16=68:b%!20=&1700310B
  1022. /b%!24=BarIcText%:b%!28=BarIcValid%:b%!32=10
  1023. $BarIcText%=""
  1024. $BarIcValid%="S!"+Task$+
  1025.  "Wimp_CreateIcon",,b% 
  1026.  BarIc%
  1027.  Comp%(MaxComp%)
  1028.  Database structures
  1029. 5ObTag%=0:ObVal%=4:ObSubs%=8:ObNext%=12:ObSize%=16
  1030.  IdNext%=0:IdObj%=4:IdName%=8
  1031. IObRef%=1                      :
  1032.  Flag set in ObVal if it's an obj ref
  1033. J                              :
  1034.  (but not a display structure pointer)
  1035.  Display structure
  1036.  xMax%(MaxGen%) :
  1037.  Current right edge of tree at each level
  1038. 4DSx%=0:DSy%=4                 :
  1039.  Person's centre
  1040. >DSxmin%=8:DSxmax%=12          :
  1041.  Person+descendants extent
  1042. 6DSSpNum%=16                   :
  1043.  Spouses numbered?
  1044. >DSName%=20                    :
  1045.  Pointer to displayed name
  1046. DSSize%=24
  1047.  Output types
  1048. 'OutScreen%=1:OutPrint%=2:OutDraw%=3
  1049.  ===================== Menus & dialog boxes =======================
  1050.  Create menus
  1051. CrMenu
  1052. (DivorceM%=
  1053. InitMenu("Di",MaxSpouse%)
  1054. OPersM%=
  1055. Menu("Pe","Ed   ^E:EditWH%,Mr:MarryWH%,Di:DivorceM%,Ci...^C,Ol,Rm")
  1056. 0PersNameLen%=128:
  1057.  PersNameBuf% PersNameLen%
  1058. hMainM%=
  1059. Menu("Fa","Pe:PersM%#IPersNameBuf%:PersNameLen%,GE:,Go  F5:GotoWH%,Sa   F3:SaveWH%,Qu   ^Q")
  1060.  Font list is set by PROCShowOpts
  1061. /FontSizeLen%=10:
  1062.  FontSizeBuf% FontSizeLen%
  1063. <FontSizeM%=
  1064. Menu("FS",":-1#WIFontSizeBuf%:FontSizeLen%")
  1065. /FontM%=
  1066. Menu("Fo","Na,Si:FontSizeM%,OS,PR")
  1067. !ShowM%=
  1068. Menu("Sh","FN,Da,YO")
  1069. 2DrawScaleLen%=15:
  1070.  DrawScaleBuf% DrawScaleLen%
  1071. ?DrawScaleM%=
  1072. Menu("Sc",":-1#WIDrawScaleBuf%:DrawScaleLen%")
  1073. 2DrawWidthLen%=15:
  1074.  DrawWidthBuf% DrawWidthLen%
  1075. ?DrawWidthM%=
  1076. Menu("LW",":-1#WIDrawWidthBuf%:DrawWidthLen%")
  1077. 6DrawM%=
  1078. Menu("Dr","Sc:DrawScaleM%,LW:DrawWidthM%")
  1079. 8OptM%=
  1080. Menu("Co","Fo:FontM%,Sh:ShowM%,Dr:DrawM%,Sa")
  1081. _BarM%=
  1082. Menu("Fa","In:InfoWH%,Pr,Co:OptM%,Rs,Rp:RepoWH%,Dr:DrawWH%,Sa   F3:SaveWH%,Qu   ^Q")
  1083. 1Menu%=0                      :
  1084.  None open yet
  1085.  Display the appropriate menu for a click in WH%
  1086. OpenMenu(X%,Y%,WH%)
  1087.  I%,M$
  1088.  WH%=MainWH% Menu%=MainM% 
  1089.  Menu%=BarM%
  1090.  Menu%=MainM% 
  1091.   MenuPerson%=
  1092. Near(X%,Y%)
  1093.  En/disable entries in Person menu
  1094.  I%=1 
  1095. Shade(PersM%,I%,MenuPerson%=0):
  1096.  MenuPerson% 
  1097. SetEdit(MenuPerson%)
  1098. SpouseMenu
  1099.     M$=
  1100. Name(MenuPerson%)
  1101. %    
  1102. SelIcon(EditWH%,EdIcMale%,
  1103.     M$=
  1104. MT("Pe")
  1105. &  $PersNameBuf%=M$:$PersM%=
  1106. M$,11)
  1107. IcTxt(GotoWH%,GoIcName%)=""
  1108. ShowOpts
  1109. MenuX%=X%-64:MenuY%=Y%
  1110.  WH%<0 
  1111. B  MenuY%=96:I%=Menu%+4        :
  1112.  Count items for icon bar menu
  1113.  I%+=24:MenuY%+=44::
  1114.  !I% 
  1115.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1116.  Open a window as a menu, canceling any menus currently open
  1117. MouseMenu(WH%)
  1118.  X%,Y%
  1119.  WH% 
  1120.  SaveWH%:X%=-240:Y%=230
  1121.  GotoWH%:X%=-270:Y%=128
  1122.  EditWH%:X%=-430:Y%=472
  1123.  ModsWH%:X%=-530:Y%=140
  1124.  "Wimp_GetPointerInfo",,b%
  1125. *Menu%=WH%:MenuX%=!b%+X%:MenuY%=b%!4+Y%
  1126.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1127.  Set up edit dialog box to edit person P%
  1128. SetEdit(P%)
  1129. IcTxt(EditWH%,EdIcName%)=
  1130. Name(P%)
  1131.   S$=
  1132. Sex(P%)
  1133. SelIcon(EditWH%,EdIcMale%,S$="M")
  1134. SelIcon(EditWH%,EdIcFemale%,S$="F")
  1135. IcTxt(EditWH%,EdIcFather%)=
  1136. Name(
  1137. Father(P%))
  1138. IcTxt(EditWH%,EdIcMother%)=
  1139. Name(
  1140. Mother(P%))
  1141. IcTxt(EditWH%,EdIcBorn%)=
  1142. Birth(P%)
  1143. IcTxt(EditWH%,EdIcDied%)=
  1144. Death(P%)
  1145. IcTxt(EditWH%,EdIcName%)=""
  1146. SelIcon(EditWH%,EdIcMale%,
  1147. SelIcon(EditWH%,EdIcFemale%,
  1148. IcTxt(EditWH%,EdIcFather%)=""
  1149. IcTxt(EditWH%,EdIcMother%)=""
  1150. IcTxt(EditWH%,EdIcBorn%)=""
  1151. IcTxt(EditWH%,EdIcDied%)=""
  1152.  Set up spouse menus
  1153. SpouseMenu
  1154.  L%,N%,P%,S%,SN%,SL%,W%
  1155. IcTxt(MarryWH%,GoIcName%)="" :
  1156.  Clear marry buf
  1157. N%=0:P%=DivorceM%+28:W%=140
  1158. &&SL%=0:S%=
  1159. Spouses(MenuPerson%,SL%)
  1160.  N%<MaxSpouse%
  1161.   SN%=
  1162. GetVal(S%,NameTg%)
  1163.  SN% 
  1164. *6    !P%=0:P%!4=-1             :
  1165.  Not last, submenu
  1166. +/    P%!8=&7000121             :
  1167.  Indirected
  1168. ,7    P%!12=SN%:P%!16=-1        :
  1169.  String, Validation
  1170. -,    L%=
  1171. ($SN%)+1:P%!20=L%:
  1172. Max(W%,16*L%)
  1173.     P%+=24:N%+=1
  1174. 0"  S%=
  1175. Spouses(MenuPerson%,SL%)
  1176.  N% P%!-24=1<<7
  1177. Shade(PersM%,2,N%=0)      :
  1178.  En/disable divorce entry
  1179. 45DivorceM%!16=W%               :
  1180.  Reset menu width
  1181.  Process a menu choice
  1182. MenuClick(Choice0%,Choice1%,Choice2%,Choice3%)
  1183.  But%,S%,N%
  1184.  "Wimp_GetPointerInfo",,mess%:But%=mess%!8
  1185.  Menu%=MainM% Choice0%+=100
  1186.  Choice0% 
  1187. Print
  1188. SetOpts(Choice1%,Choice2%,Choice3%,But%) :
  1189.  Choices
  1190. Mods(".R") 
  1191. Reset
  1192. Save(RepoWH%,SaIcOK%,4)
  1193. Save(DrawWH%,SaIcOK%,4)
  1194.  6,103:
  1195. Save(SaveWH%,SaIcOK%,4)
  1196.  7,104:
  1197.  100                     :
  1198.  Person submenu
  1199.  Choice1% 
  1200.  -1,0:
  1201. MouseMenu(EditWH%)
  1202.  2                      :
  1203.  Divorce
  1204.  Choice2%>-1 
  1205. J:      N%=DivorceM%!(28+24*Choice2%+12) :
  1206.  Name in menu
  1207. K+      S%=
  1208. Look($N%):
  1209.  S%=0 
  1210.  1,"Spouse"
  1211. L"      
  1212. Divorce(MenuPerson%,S%)
  1213. M        
  1214. EditChild(MenuPerson%)
  1215. Older
  1216. Kill(MenuPerson%):
  1217.  Person%=MenuPerson% 
  1218. Goto(0)
  1219.  101:
  1220. ObjEdit
  1221.  102:
  1222. MouseMenu(GotoWH%)
  1223.  But%=1 
  1224.  Menu%=BarM% 
  1225. ShowOpts :
  1226.  Update ticks on choices
  1227.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1228.   Menu%=0
  1229.  E$ = "<Item>,<Item>,.."
  1230.  <Item> = "<String>:[<Sub_val>[#<Flags>]]"
  1231.  No <Sub_val> => -1
  1232.  Flags = I<ptr>:<len> => indirected (must be last flag)
  1233.          W => writable
  1234. Menu(Title$,E$)
  1235.  I%,M%,N%,Width%
  1236. e-I%=1:N%=0:
  1237.  N%+=1:I%=
  1238. E$,",",I%+1):
  1239.  I%=0
  1240. InitMenu(Title$,N%)
  1241. I%=M%+4:Width%=8
  1242. i   I%+=24:E$=
  1243. MenuItem(I%,E$)
  1244.  I%!8 
  1245.  1<<8 N%=
  1246. ($(I%!12)) 
  1247. ($(I%+12))
  1248. Max(Width%,N%)
  1249.  E$=""
  1250. m-!I%=!I% 
  1251.  1<<7               :
  1252.  Last item
  1253. M%!16=(Width%+1)*CharW%
  1254. InitMenu(Title$,Entries%)
  1255.  M% 28+24*Entries%
  1256. MT(Title$)
  1257. u#M%?12=7:M%?13=2:M%?14=7:M%?15=0
  1258. M%!16=160:M%!20=44:M%!24=0
  1259. MenuItem(I%,E$)
  1260.  Rest$,S$,P%,S%
  1261.  this-entry "," other-entries
  1262. |3S%=
  1263. E$+",",",",S%):Rest$=
  1264. E$,S%+1):E$=
  1265. E$,S%-1)
  1266.  String-to-display ":" submenu
  1267. E$+":",":")
  1268. E$,S%-1)
  1269.  Translate 2 char message token at start of string
  1270.  S$>"" S$=
  1271. S$,2))+
  1272. S$,3)
  1273. E$,S%+1):
  1274.  E$="" E$="-1"
  1275. "!I%=0:I%!4=
  1276. (E$):I%!8=&7000021
  1277.  sub-val "#" options
  1278. P%=0:E$=
  1279. E$+"#","#")+1)
  1280.  E$>""                   :
  1281.  Optional flags
  1282. E$,1) 
  1283.  "I"                    :
  1284.  Indirect
  1285.     I%!8=I%!8 
  1286.  1<<8
  1287. -    S%=
  1288. E$,":")          :
  1289.  After pointer
  1290. )    P%=
  1291. E$,2,S%-2))  :
  1292.  Buf pointer
  1293.     I%!12=P%:I%!16=-1
  1294. %    I%!20=
  1295. E$,S%+1)) :
  1296.  Buf len
  1297. 2    E$=""                     :
  1298.  no more flags
  1299.  "W":!I%=!I% 
  1300.  1<<2    :
  1301.  Writeable
  1302.   E$=
  1303. E$,2)
  1304.  P%=0 
  1305. :  P%=I%+12:S%=
  1306. (S$)+1       :
  1307.  Long string => indirect
  1308.  S%>12 
  1309.  P% S%
  1310. 3    I%!8=I%!8 
  1311.  1<<8:I%!12=P%:I%!16=-1:I%!20=S%
  1312. $P%=S$
  1313. =Rest$
  1314.  (Un)Shade menu entry
  1315. Shade(Menu%,Entry%,Shade%)
  1316.  B%:B%=1<<22
  1317. /Menu%+=28+24*Entry%+8         :
  1318.  Menu flags
  1319. &!Menu%=!Menu% 
  1320.  Shade% 
  1321.  (Un)Tick menu entry
  1322. SelEntry(Menu%,Entry%,Tick%)
  1323. Menu%+=28+24*Entry%
  1324. (!Menu%=!Menu% 
  1325.  (Tick%<>0) 
  1326.  ============================= Edit ===============================
  1327. Goto(P%)
  1328. Person%=P%
  1329. GForce%=2                      :
  1330.  Scroll window to centre new person
  1331.  Force note window and title
  1332.  P% $NoteTitle%=
  1333. Name(P%):
  1334. OpenNotes 
  1335. Close(NoteWH%)
  1336.  Create a level 0 NOTE object giving the current person's name
  1337. SetPerson
  1338.  Mod%,N%,O%,P%
  1339.  Kill any old person note
  1340. P%=Root%+ObSubs%
  1341.   O%=!P%:N%=O%+ObNext%
  1342.  O%!ObTag%=NoteTg% 
  1343.  O%!ObVal% 
  1344. '      
  1345. $(O%!ObVal%),6)="Person" 
  1346.         
  1347. Free(O%!ObVal%)
  1348.         !P%=!N%:N%=P%
  1349.       
  1350.         
  1351.   P%=N%
  1352. @Mod%=Modified%                :
  1353.  Preserve modification state
  1354.  Person% 
  1355. SetStr(Root%,NoteTg%,"Person "+
  1356. Name(Person%),
  1357. Modified%=Mod%
  1358.  Return the person near screen X%,Y%.  Try the dummy CHIL
  1359.  at the top of the tree first, then each member of each FAM.
  1360. Near(X%,Y%)
  1361.  B%,D%,DS%,BD%,F%,S%,R%
  1362. >R%=1.5*LineHeight%            :
  1363.  Distance from name centre
  1364. ,!b%=MainWH%:
  1365.  "Wimp_GetWindowState",,b%
  1366. @X%-=(b%!4-b%!20):Y%-=(b%!16-b%!24) :
  1367.  convert to work coords
  1368.  B%=0:BD%=Infinity%
  1369. F%=0:S%=TopChil%
  1370.  S%>1
  1371.  S%!ObTag% 
  1372.  HusbTg%,WifeTg%,ChilTg%
  1373.     DS%=ObVal%!(S%!ObSubs%)
  1374. (    D%=
  1375. (X%-DS%!DSx%)+
  1376. (Y%-DS%!DSy%)
  1377.      
  1378.  IF D%<BD% B%=S%:BD%=D%
  1379.  D%<R% 
  1380. Val(S%)
  1381.   S%=S%!ObNext%
  1382.  S%=0
  1383. 7    
  1384. GetSub(Root%,FamTg%,F%) S%=F%!ObSubs% 
  1385.  S%=1
  1386.  IF B% B%=FNVal(B%)
  1387.  Open an Edit window for person P% (may be 0)
  1388. EditPerson(P%)
  1389. MenuPerson%=P%
  1390. SetEdit(P%)
  1391. MouseMenu(EditWH%)
  1392.  Mouse or key in edit window.  Note CR is handled wrongly if there
  1393.  is any K command in a validation string.  Do K stuff here instead.
  1394. Edit(Ic%,But%)
  1395.  S%,M%
  1396.  Ic%=EdIcCan% 
  1397. Close(EditWH%)
  1398.  "Wimp_CreateMenu",,-1
  1399.   Menu%=0
  1400.  But% 
  1401.  UpArrow%
  1402. ,  S%=(Ic%+EdIcMother%) 
  1403.  (EdIcMother%+1)
  1404. Caret(EditWH%,S%,
  1405.  DownArrow%
  1406. "  S%=(Ic%+1) 
  1407.  (EdIcMother%+1)
  1408. Caret(EditWH%,S%,
  1409.  CR%:Ic%=EdIcOK%
  1410.  CtrlS%
  1411. $  M%=
  1412. SelIcon(EditWH%,EdIcMale%)
  1413. SelIcon(EditWH%,EdIcMale%,
  1414. SelIcon(EditWH%,EdIcFemale%,M%)
  1415.  Ic%<>EdIcOK% 
  1416. Edited
  1417. Close(EditWH%)
  1418.  "Wimp_CreateMenu",,-1:Menu%=0
  1419.  Person% Force%=1 
  1420. Goto(MenuPerson%)
  1421.  Set edited details
  1422. Edited
  1423.  N$,Sex$
  1424. !N$=$
  1425. IcTxt(EditWH%,EdIcName%)
  1426.  N$="" 
  1427. MT("NN")
  1428.  MenuPerson% 
  1429. Name(MenuPerson%)<>N$ 
  1430. !    
  1431.  Name changed - reinsert
  1432. )    
  1433. SetStr(MenuPerson%,NameTg%,N$,
  1434. %    
  1435. RemSubObj(Root%,MenuPerson%)
  1436. Insert(MenuPerson%)
  1437.   MenuPerson%=
  1438. Find(N$)
  1439. EventDate(MenuPerson%,BirtTg%,$
  1440. IcTxt(EditWH%,EdIcBorn%))
  1441. EventDate(MenuPerson%,DeatTg%,$
  1442. IcTxt(EditWH%,EdIcDied%))
  1443. "BN$=$
  1444. IcTxt(EditWH%,EdIcFather%):
  1445. Father(MenuPerson%,
  1446. Find(N$))
  1447. #BN$=$
  1448. IcTxt(EditWH%,EdIcMother%):
  1449. Mother(MenuPerson%,
  1450. Find(N$))
  1451. SelIcon(EditWH%,EdIcMale%)  :Sex$="M"
  1452. SelIcon(EditWH%,EdIcFemale%):Sex$="F"
  1453.                           :Sex$=""
  1454. Sex(MenuPerson%,Sex$)
  1455.  Set the DATE of P%'s Tag% event to Val$
  1456. EventDate(P%,Tag%,Val$)
  1457.  P%=0 
  1458.  1,"PROCEventDate"
  1459.  Val$>"" 
  1460. SetSub(P%,Tag%,0,
  1461. GetSub(P%,Tag%,E%) 
  1462. SetStr(E%,DateTg%,Val$,
  1463. Father(P%)=
  1464. Parent(P%,HusbTg%)
  1465. Mother(P%)=
  1466. Parent(P%,WifeTg%)
  1467.  Get the family pointed to by P%'s FAMC sub-object.  Return
  1468.  the person pointed to by its Tag% sub-object or 0 if none.
  1469. Parent(P%,Tag%)
  1470.  P%=0 
  1471.  Tag%=0 
  1472.  1,"FNParent"
  1473. >2P%=
  1474. GetVal(P%,FamcTg%):
  1475. GetVal(P%,Tag%)
  1476.  Return P%'s father, mother, self or 0.
  1477. Fore(P%)
  1478.  P%=0 
  1479. Father(P%):
  1480. Mother(P%):
  1481. Birth(P%)=
  1482. Date(P%,BirtTg%)
  1483. Death(P%)=
  1484. Date(P%,DeatTg%)
  1485.  Return the value string for the DATE sub-object
  1486.  of P%'s event sub-object with Tag%
  1487. Date(P%,Tag%)
  1488.  P%=0 
  1489.  1,"FNDate"
  1490. T4E%=0:
  1491. GetSub(P%,Tag%,E%) 
  1492. GetStr(E%,DateTg%)
  1493. Sex(P%,S$)
  1494.  P%=0 
  1495.  1,"PROCSex"
  1496. SetStr(P%,SexTg%,S$,
  1497. Sex(P%)=
  1498. GetStr(P%,SexTg%)
  1499. MaleFemale(
  1500.  Him%,
  1501.  Her%)
  1502. Sex(Him%)="F" 
  1503. Sex(Her%)="M" 
  1504.  Him%,Her%
  1505.  Him% 
  1506. Sex(Him%,"M")
  1507.  Her% 
  1508. Sex(Her%,"F")
  1509.  Swap MenuPerson% with his earlier sibling
  1510. Older
  1511.  F%,P%,Old%,C%
  1512. h#F%=
  1513. GetVal(MenuPerson%,FamcTg%)
  1514.   Old%=0:P%=F%+ObSubs%
  1515.     C%=!P%
  1516.  C%!ObTag%=ChilTg% 
  1517. n"      
  1518. Val(C%)=MenuPerson% 
  1519.         F%=0
  1520. pB        
  1521.  Old% 
  1522.  Old%!ObVal%,C%!ObVal%:Modified%=
  1523. :Force%=1:
  1524.       
  1525.       Old%=C%
  1526. s        
  1527.     P%=C%+ObNext%
  1528. Name(MenuPerson%)+" "+
  1529. MT("NE")
  1530.  Fill in edit box for a new person whose parent is Dad% (may be female).
  1531.  If he has one spouse assume she is the child's other parent.
  1532.  If the child's father is known initialise his family name.
  1533. EditChild(Dad%)
  1534.  L%,Mum%,F$
  1535.  Dad%=0 
  1536. EditPerson(0):
  1537. :L%=0:Mum%=
  1538. Spouses(Dad%,L%):
  1539. Spouses(Dad%,L%) Mum%=0
  1540. MaleFemale(Dad%,Mum%)
  1541. ;F$="":
  1542.  Dad% F$=
  1543. FamName(
  1544. Name(Dad%)):
  1545.  F$>"" F$=" "+F$
  1546. IcTxt(EditWH%,EdIcName%)=F$
  1547. SelIcon(EditWH%,EdIcMale%,
  1548.  Default male.
  1549. SelIcon(EditWH%,EdIcFemale%,
  1550. IcTxt(EditWH%,EdIcFather%)=
  1551. Name(Dad%)
  1552. IcTxt(EditWH%,EdIcMother%)=
  1553. Name(Mum%)
  1554. IcTxt(EditWH%,EdIcBorn%)=""
  1555. IcTxt(EditWH%,EdIcDied%)=""
  1556. Open(EditWH%)
  1557. Caret(EditWH%,EdIcName%,
  1558.  Caret at start
  1559. HMenuPerson%=0                 :
  1560.  Create new person if edit completed
  1561. Father(C%,P%)
  1562. ChkSex(P%,"M","Ml")
  1563. Parent(C%,P%,HusbTg%)
  1564. Mother(C%,P%)
  1565. ChkSex(P%,"F","Fe")
  1566. Parent(C%,P%,WifeTg%)
  1567. ChkSex(P%,Gender$,GT$)
  1568.  P%=0 
  1569. Sex(P%) 
  1570.  Gender$
  1571. Sex(P%,Gender$)
  1572. Name(P%)+" "+
  1573. MT("IN")+" "+
  1574. MT(GT$)
  1575.  Set C%'s Tag% parent to P%
  1576. Parent(C%,P%,Tag%)
  1577.  Dad%,Mum%,F%,O%
  1578.  C%=0 
  1579.  1,"PROCParent"
  1580. GetVal(C%,FamcTg%):Dad%=0:Mum%=0
  1581.  ove C% from current family unless the parent is already there
  1582. GetVal(F%,Tag%)=P% 
  1583. 7  Dad%=
  1584. GetVal(F%,HusbTg%):Mum%=
  1585. GetVal(F%,WifeTg%)
  1586. RemSub(F%,ChilTg%,C%)
  1587. ChkFam(F%)
  1588.  C% now an orphan.  Set new parent.
  1589.  Tag%=HusbTg% Dad%=P% 
  1590.  Mum%=P%
  1591.  Dad%=0 
  1592.  Mum%=0 
  1593.  See if Dad has a family with Mum (either may be 0)
  1594.  Dad% 
  1595.   O%=0
  1596. GetSub(Dad%,FamsTg%,O%) 
  1597.  F%=0
  1598. 4    F%=
  1599. Val(O%):
  1600. GetVal(F%,WifeTg%)<>Mum% F%=0
  1601.  See if Mum has a family with Dad
  1602.  Mum% 
  1603.  F%=0 
  1604.   O%=0
  1605. GetSub(Mum%,FamsTg%,O%) 
  1606.  F%=0
  1607. 4    F%=
  1608. Val(O%):
  1609. GetVal(F%,HusbTg%)<>Dad% F%=0
  1610.  F%=0 F%=
  1611. NewFam(Dad%,Mum%)
  1612. SetSub(C%,FamcTg%,F% 
  1613.  ObRef%,
  1614. SetSub(F%,ChilTg%,C% 
  1615.  ObRef%,
  1616. ChkFam(F%)
  1617. Modified%=
  1618. :Force%=1
  1619.  ==================== Individuals & families ======================
  1620.  Look up name N$ and return person if found, else 0
  1621. Look(N$)
  1622.  H%,P%
  1623. Hash(N$):P%=Hash%!H%:
  1624. Name(P%)=N$ 
  1625. GetSub(Root%,IndiTg%,P%)
  1626. Name(P%)=N$ Hash%!H%=P%:=P%
  1627.  Find an existing person named N$ or create a new one
  1628. Find(N$)
  1629.  N$="" 
  1630. Look(N$)
  1631.  P%=0 P%=
  1632. NewIndi(N$):
  1633. Insert(P%) :
  1634.  Sort into Root%'s list
  1635. InitHash
  1636. 1HashSize%=1<<12:HashMask%=(HashSize%-1) 
  1637.  Hash%=0 
  1638.  Hash% HashSize%
  1639.  H%=0 
  1640.  HashSize%-1 
  1641.  4:Hash%!H%=0:
  1642. Hash($b%)
  1643.  I%,H%:H%=0
  1644.  I%=0 
  1645.  9:H%+=H%+b%?I%:
  1646.  HashMask%
  1647. NewIndi(N$)
  1648. Object(IndiTg%,0)
  1649. SetStr(P%,NameTg%,N$,
  1650.  N$>"" Hash%!
  1651. Hash(N$)=P%
  1652. Modified%=
  1653. :Force%=1
  1654.  Every FAM member's first sub-object is a display structure
  1655. DStruct(P%)
  1656.  D%,O%,S%
  1657. S%=P%!ObSubs%
  1658.  S%!ObTag%=DispTg% 
  1659. =S%!ObVal%
  1660. Alloc(DSSize%):D%!DSName%=0
  1661. Object(DispTg%,D%)
  1662. P%!ObSubs%=O%:O%!ObNext%=S%
  1663.  Create a new family with Dad% and Mum%.  Link it to them and v.v.
  1664. NewFam(Dad%,Mum%)
  1665. Object(FamTg%,0)
  1666. Tail(Root%)=F%
  1667.  Dad% 
  1668. SetSub(F%,HusbTg%,Dad% 
  1669.  ObRef%,
  1670. SetSub(Dad%,FamsTg%,F% 
  1671.  ObRef%,
  1672.  Mum% 
  1673. SetSub(F%,WifeTg%,Mum% 
  1674.  ObRef%,
  1675. SetSub(Mum%,FamsTg%,F% 
  1676.  ObRef%,
  1677.  Add O% as an INDI just before the first INDI
  1678.  sub-object of root with a name after O%'s
  1679. Insert(O%)
  1680. Position(O%)
  1681. O%!ObNext%=!P%
  1682. !P%=O%
  1683. Position(O%)
  1684.  P%,N$,NO$,F$,FO$
  1685. #NO$=
  1686. Name(O%):FO$=
  1687. FamName(NO$)
  1688. P%=Root%+ObSubs%
  1689.   O%=!P%
  1690.  O%!ObTag%=IndiTg% 
  1691. $    N$=
  1692. Name(O%):F$=
  1693. FamName(N$)
  1694.  F$>FO$ 
  1695.  F$=FO$ 
  1696.  N$>NO$ 
  1697.   P%=O%+ObNext%
  1698.  If family F% has < 2 members, unlink it & kill it
  1699. ChkFam(F%)
  1700.  M%,N%
  1701.  F%=0 
  1702.  1,"PROCChkFam"
  1703. S%=F%!ObSubs%:N%=0
  1704.  N%<2
  1705.  S%!ObTag% 
  1706.  ChilTg%,HusbTg%,WifeTg%:N%+=1
  1707.   S%=S%!ObNext%
  1708.  N%<2 
  1709. Kill(F%)
  1710.  ============================= Notes ==============================
  1711.  Return Person%'s first or next CONT or NOTE sub-object.
  1712.  Call with N%=0 for first.  Result also returned in O%.
  1713. GetNote(
  1714.  O%=N% O%=0
  1715. 8)  O%=
  1716. GetSub(N%,ContTg%,O%):
  1717. :&O%=
  1718. GetSub(Person%,NoteTg%,N%):=O%
  1719. OpenNotes
  1720.  Lines%,N%,O%
  1721. Lines%=0:N%=0
  1722. GetNote(N%,O%):Lines%+=1:
  1723. @+!b%=NoteWH%:
  1724.  "Wimp_GetWindowInfo",,b%
  1725. Extent(NoteWH%,b%!52-b%!44,(Lines%+1)*(CharH%+4),
  1726.  Draw Person's first NOTE object and any CONT sub-objects
  1727. DrawNote(X%,Y%)
  1728.  N%,O%
  1729.  Person%=0 
  1730. X%+=8:Y%-=8:N%=0
  1731. GetNote(N%,O%)
  1732.  O%!ObVal% 
  1733.  X%,Y%:
  1734.  $(O%!ObVal%);
  1735.   Y%-=CharH%+4
  1736.  Broadcast a request for an external edit of P%'s
  1737.  notes.  Should get EditAck reply or EditRq bounce.
  1738. EditNotes
  1739.  I%,N$
  1740.  Person%=0 
  1741.  1,"PROCEditNotes"
  1742. mess%!20=TextType%
  1743. W@mess%!24=1                    :
  1744.  Arbitrary client job handle
  1745. X6mess%!28=1                    :
  1746.  Continue editing?
  1747.  Tidy name for use as job parent Id
  1748. Name(Person%)
  1749.  N$>"" 
  1750. Alpha(N$) N$=
  1751. N$,2):
  1752.  I%<=
  1753. Alpha(
  1754. N$,I%)) I%+=1 
  1755. N$,I%-1)+
  1756. N$,I%+1)
  1757. `($(mess%+32)=
  1758. N$,19)+
  1759.  Parent ID.
  1760. Send(EditRq,NoteLeaf$,18,mess%,0,0,52)
  1761. WriteNotes(F$)        :
  1762.  Write notes to a file
  1763. WriteNotesFile(F%,"")
  1764. SetFileType(F$,TextType%)
  1765. WriteNotesFile(F%,Prefix$)
  1766.  O%,N%:N%=0
  1767. GetNote(N%,O%)
  1768. #F%,Prefix$+
  1769. Null(O%!ObVal%)
  1770.  Read notes for the current person from a file
  1771. LoadNotes(F$)
  1772.  F%,P%
  1773. w)F%=
  1774. (F$):
  1775.  F%=0 
  1776. MT("CR")+" "+F$
  1777.  Person%=0 
  1778. MT("NP")
  1779.  Delete all Person's existing note sub-objects
  1780. DelTag(Person%,NoteTg%)
  1781. Tail(Person%)
  1782. }7  !P%=
  1783. Object(NoteTg%,
  1784. String(
  1785. #F%)):P%=!P%+ObSubs%
  1786. 7  !P%=
  1787. Object(ContTg%,
  1788. String(
  1789. #F%)):P%=!P%+ObNext%
  1790.  F$=NoteFile$ 
  1791.  F$=Scrap$ 
  1792. DelFile(NoteFile$) :
  1793.  Delete scrap file.
  1794. OpenNotes
  1795. Modified%=
  1796.  =========================== Spouses ==============================
  1797.  Return P%'s first spouse if F%=0 else return next
  1798.  spouse.  Update F% to P%'s FAMS.  Return 0 when no
  1799.  more spouses.  Ignore families with unknown spouse.
  1800. Spouses(P%,
  1801.  H%,W%,FO%
  1802.  P%=0 
  1803.  1,"FNSpouses 1"
  1804. GetSub(P%,FamsTg%,F%)
  1805.   FO%=
  1806. Val(F%)
  1807.   H%=
  1808. GetVal(FO%,HusbTg%)
  1809.   W%=
  1810. GetVal(FO%,WifeTg%)
  1811.  1,"FNSpouses 2"
  1812.  Ensure that there is a family with parents Mum% and Dad%
  1813. Marry(Dad%,Mum%)
  1814.  F%,O%,H%,W%
  1815.  Dad%=0 
  1816.  Mum%=0 
  1817. MaleFemale(Dad%,Mum%)     :
  1818.  Ensure Dad% is male
  1819. 9O%=0:H%=-1:W%=-1              :
  1820.  Dad already married?
  1821. GetSub(Dad%,FamsTg%,O%)
  1822. ?  F%=
  1823. Val(O%):H%=
  1824. GetVal(F%,HusbTg%):W%=
  1825. GetVal(F%,WifeTg%)
  1826.  H%=Dad% 
  1827.  W%=Mum% 
  1828.  F%=0 
  1829. 9  O%=0:H%=-1:W%=-1            :
  1830.  Mum already married?
  1831. GetSub(Mum%,FamsTg%,O%)
  1832. A    F%=
  1833. Val(O%):H%=
  1834. GetVal(F%,HusbTg%):W%=
  1835. GetVal(F%,WifeTg%)
  1836.  H%=Dad% 
  1837.  W%=Mum% 
  1838.  Add new spouse to arbitrary existing single-parent family if any
  1839.  H%=0:
  1840. SetSub(F%,HusbTg%,Dad% 
  1841.  ObRef%,
  1842. SetSub(Dad%,FamsTg%,F% 
  1843.  ObRef%,
  1844.  W%=0:
  1845. SetSub(F%,WifeTg%,Mum% 
  1846.  ObRef%,
  1847. SetSub(Mum%,FamsTg%,F% 
  1848.  ObRef%,
  1849. NewFam(Dad%,Mum%)
  1850. Modified%=
  1851. :Force%=1
  1852.  Remove mother from family in which Dad%
  1853.  and Mum% are parents if neither is null
  1854. Divorce(Dad%,Mum%)
  1855.  F%,O%
  1856.  Dad%=0 
  1857.  Mum%=0 
  1858. MaleFemale(Dad%,Mum%)
  1859. GetSub(Dad%,FamsTg%,O%)
  1860.   F%=
  1861. Val(O%)
  1862. GetVal(F%,WifeTg%)=Mum% 
  1863.      
  1864. RemSub(F%,WifeTg%,Mum%)
  1865.      
  1866. RemSub(Mum%,FamsTg%,F%)
  1867. ChkFam(F%)
  1868.     Modified%=
  1869. :Force%=1
  1870.         
  1871. Name(Dad%)+" "+
  1872. MT("NM")+" "+
  1873. Name(Mum%)
  1874. OppSex(P%)
  1875. Sex(P%) 
  1876.  "M":="F"
  1877.  "F":="M"
  1878.  ======================== Name completion =========================
  1879.  Try to complete the name in an icon.  Set WHComp%
  1880.  and IHComp% to the icon we are completing.
  1881. Complete(WH%,IH%)
  1882.  A%,ReqSex$:ReqSex$=""
  1883.  WH% 
  1884.  EditWH%
  1885.  IH% 
  1886.  EdIcFather%:ReqSex$="M"
  1887.  EdIcMother%:ReqSex$="F"
  1888.  EdIcName%
  1889.  Only for mother, father, name.
  1890.  MarryWH%:ReqSex$=
  1891. OppSex(MenuPerson%)
  1892.  GotoWH%
  1893. IcTxt(WH%,IH%)
  1894. Complete($A%,ReqSex$)
  1895. Caret(WH%,IH%,
  1896. WHComp%=WH%:IHComp%=IH%
  1897.  Return longest unambiguous completion of N$ with given
  1898.  sex.  If > 1 match, open the pick window else close it.
  1899. Complete(N$,ReqSex$)
  1900.  Len%,P%,Prefix$,PN$,LowN$
  1901. LowN$=
  1902. Lower(N$)
  1903. #NComp%=0:Prefix$="*":Len%=
  1904. GetSub(Root%,IndiTg%,P%)
  1905.  ReqSex$="" 
  1906. Sex(P%)=ReqSex$ 
  1907.     PN$=
  1908. Name(P%)
  1909. $    
  1910. Lower(
  1911. PN$,Len%))=LowN$ 
  1912. 7      
  1913.  NComp%<=MaxComp% Comp%(NComp%)=P%:NComp%+=1
  1914. <      Prefix$=
  1915. Common(Prefix$,PN$) :
  1916.  Max shared prefix.
  1917.         
  1918.  NComp%=0 
  1919.  NComp%>1 
  1920. OpenComp 
  1921. Close(CompWH%)
  1922.  Prefix$="" 
  1923.  Prefix$="*" 
  1924. =Prefix$
  1925.  Return longest common prefix
  1926. Common(P$,N$)
  1927.  P$="*" 
  1928. Lower(P$)
  1929. Lower(N$) 
  1930. +L%=1:
  1931. P$,L%)=
  1932. Lower(
  1933. N$,L%)):L%+=1:
  1934. N$,L%-1)
  1935. OpenComp
  1936.  I%,M%:M%=0
  1937.  I%=0 
  1938.  NComp%-1
  1939. Max(M%,
  1940. Name(Comp%(I%))))
  1941. !I%=NComp%:
  1942.  I%>MaxComp% I%+=1
  1943. Extent(CompWH%,(M%+2)*CharW%,I%*CharH%+16,
  1944. DrawComp(XW%,YW%)
  1945.  I%=0 
  1946.  NComp%-1
  1947.  XW%+8,YW%-8-CharH%*I%:
  1948. Name(Comp%(I%))
  1949.  NComp%>MaxComp% 
  1950.  XW%+8,YW%-8-CharH%*NComp%:
  1951.  "..."
  1952.  Click in completion list.  Set text in icon being completed.
  1953. Comp(Y%)
  1954.  I%,YW%,IH%,WH%
  1955. ",!b%=CompWH%:
  1956.  "Wimp_GetWindowState",,b%
  1957. YW%=b%!16-b%!24
  1958. I%=(YW%-8-Y%) 
  1959.  CharH%
  1960.  I%>=NComp% 
  1961.  Set text in icon.  Ensure window open and redraw icon
  1962. IcTxt(WHComp%,IHComp%)=
  1963. Name(Comp%(I%))
  1964. Close(CompWH%)
  1965. Open(WHComp%):
  1966. Caret(WHComp%,IHComp%,
  1967.  =========================== Messages =============================
  1968.  Received a type 17 or 18 message.  The message is at b%.
  1969. Receive(Size%,SrcTask%,HisRef%,Action%)
  1970.  P%,Type%,F$
  1971.  Ignore own messages.
  1972.  SrcTask%=Task% 
  1973.  PROCD("Rec &"+STR$~Action%)
  1974.  Action% 
  1975.  Quit:Modified%=
  1976.  PreQuit
  1977.  Modified% 
  1978. NotOK(
  1979. MT("UC")) 
  1980. :1    b%!12=HisRef%:
  1981.  "Wimp_SendMessage",19,b%
  1982.  DataSave,EditDataSave
  1983.  He has data for us.  Tell him where to stick it.  Notes might be
  1984.  considered 'safe' but that confuses !Zap so say they're unsafe.
  1985.   b%!36=-1
  1986. Send(DataSaveAck,Scrap$,17,b%,SrcTask%,HisRef%,44)
  1987.  DataSaveAck              :
  1988.  He says where to save data
  1989.  "Wimp_CreateMenu",,-1:Menu%=0
  1990.   F$=
  1991. GetZStr(b%+44)
  1992. SaveType(F$,b%!36>=0)
  1993.  Tell him to load data from file.  Rest of mess set up from our
  1994.  DataSave.  This should be sent as type 18 (recorded) but StrongEd
  1995.  doesn't seem to reply soon enough.
  1996. Send(DataLoad,F$,17,mess%,SrcTask%,HisRef%,44)
  1997.  DataLoad                 :
  1998.  He wants us to load a file
  1999.   Type%=b%!40
  2000.   F$=
  2001. GetZStr(b%+44)
  2002.  "Wimp_GetPointerInfo",,b%
  2003. Load(F$,b%!12=-2)       :
  2004.  Reset for drag to icon bar
  2005.  Tell him we got it.  StrongED is logical but non-standard
  2006.  because it looks at b%!36 from DataLoadAck instead of DataSaveAck.
  2007. P:  b%!36=-1                    :
  2008.  For naughty StrongED.
  2009. Send(DataLoadAck,F$,17,b%,SrcTask%,HisRef%,44)
  2010.  F$=Scrap$ 
  2011. DelFile(Scrap$)
  2012.  Type%=TextType% 
  2013. ExtEdAbort
  2014.  DataOpen                 :
  2015.  Load a Filer_Run file
  2016.  b%!40<>TreeType% 
  2017.   F$=
  2018. GetZStr(b%+44)
  2019.  Acknowledge DataOpen now in case load fails
  2020. XE  b%!36=-1                    :
  2021.  For naughty StrongED (see above)
  2022. Send(DataLoadAck,F$,17,b%,SrcTask%,HisRef%,44)
  2023. Load(F$,
  2024. )           :
  2025.  Reset for DataOpen
  2026.  DataLoadAck              :
  2027.  He has loaded & deleted data
  2028.  EditAck                  :
  2029.  External edit request accepted
  2030.   ExtEdJob%=b%!24
  2031. ^/  mess%!20=ExtEdJob%          :
  2032.  Job handle
  2033. _8  mess%!36=0                  :
  2034.  Estimated data size
  2035.   mess%!40=TextType%
  2036. Send(EditDataSave,NoteLeaf$,18,mess%,SrcTask%,HisRef%,44)
  2037. b<  SaveType%=TextType%         :
  2038.  ember what we're saving
  2039.  HelpRequest
  2040.   F$=
  2041. Help(b%!32,b%!36)
  2042.  F$>"" 
  2043. Send(HelpReply,F$,17,b%,SrcTask%,HisRef%,20)
  2044.  MenusDeleted
  2045.   Menu%=0
  2046.  Received a type 19 (acknowledge) message (in b%).  If it appears to
  2047.  come from this task then it is an unanswered type 18 (recorded).
  2048. RcvAck(Size%,SrcTask%,Action%)
  2049.  P%,Type%,F$
  2050.  SrcTask%<>Task% 
  2051.  It's one of mine
  2052.  Action% 
  2053.  EditRq                   :
  2054.  Unanswered External edit request
  2055. WriteNotes(NoteFile$)
  2056.  "Filer_Run "+NoteFile$ :
  2057.  Hope an editor will catch it
  2058.  OTHERWISE PROCD("Ack "+STR$~Action%)
  2059.  Send a message containing a string
  2060. Send(Action%,String$,N%,Buf%,Dest%,Ref%,Offset%)
  2061. Buf%!12=Ref%
  2062. Buf%!16=Action%
  2063. MessStr(Buf%,Offset%,String$)
  2064.  "Wimp_SendMessage",N%,Buf%,Dest%
  2065.  Insert String$ at Offset% in message in Buf%.  Set message length.
  2066. MessStr(Buf%,Offset%,String$)
  2067. $(Buf%+Offset%)=String$+
  2068. &!Buf%=(Offset%+4+
  2069. (String$)) 
  2070.  Close any external edit job
  2071. ExtEdAbort
  2072.  ExtEdJob%=0 
  2073. +mess%!12=0                    :
  2074.  My ref
  2075. mess%!16=EditAbort
  2076. -mess%!20=0                    :
  2077.  Reserved
  2078. mess%!24=ExtEdJob%
  2079. mess%!0=28
  2080.  "Wimp_SendMessage",17,mess%,SrcTask%
  2081. =ExtEdJob%=0                   :
  2082.  No current external edit
  2083. Help(WH%,IH%)
  2084. MHelp(WH%,IH%)
  2085.  T$>"" T$=
  2086. MT(T$)
  2087. MHelp(WH%,IH%)
  2088.  WH% 
  2089.  -2:="H01"
  2090.  MainWH%:="H02"
  2091.  NoteWH%:="H03"
  2092.  CompWH%:="H04"
  2093.  InfoWH%:="H05"
  2094.  EditWH%
  2095.  IH% 
  2096.  EdIcName%:="H06"
  2097.  EdIcBorn%:="H07"
  2098.  EdIcDied%:="H08"
  2099.  EdIcFather%:="H09"
  2100.  EdIcMother%:="H10"
  2101.  EdIcMale%:="H11"
  2102.  EdIcFemale%:="H12"
  2103.  EdIcCan%:="H13"
  2104.  EdIcOK%:="H14"
  2105.  GotoWH%
  2106.  IH% 
  2107.  GoIcName%:="H15"
  2108.  GoIcCan%:="H16"
  2109.  GoIcCur%:="H25"
  2110.  GoIcOK%:="H17"
  2111.  MarryWH%
  2112.  IH% 
  2113.  GoIcName%:="H18"
  2114.  GoIcCan%:="H19"
  2115.  GoIcCur%:="H25"
  2116.  GoIcOK%:="H20"
  2117.  ModsWH%
  2118.  IH% 
  2119.  MoIcDisc%:="H29"
  2120.  MoIcCan%:="H30"
  2121.  MoIcSave%:="H31"
  2122.  RepoWH%
  2123.  IH% 
  2124.  SaIcFile%:="H28"
  2125.  SaIcSprite%:="H26"
  2126.  SaIcOK%:="H27"
  2127.  SaIcCan%:="H24"
  2128.  SaveWH%
  2129.  IH% 
  2130.  SaIcFile%:="H21"
  2131.  SaIcSprite%:="H22"
  2132.  SaIcOK%:="H23"
  2133.  SaIcCan%:="H24"
  2134.  DrawWH%
  2135.  IH% 
  2136.  SaIcFile%:="H32"
  2137.  SaIcSprite%:="H33"
  2138.  SaIcOK%:="H34"
  2139.  SaIcCan%:="H24"
  2140.  ============================= Load ===============================
  2141.  Check the command line for file to load (and print)
  2142.  I%,PrintIt%
  2143.  "OS_GetEnv" 
  2144. $b%,"-quit")
  2145.  I%=0 
  2146. 6I%=b%+I%+5:
  2147.  ?I%=Space% I%+=1:
  2148.  Find prog name
  2149.  ?I%>Space% I%+=1:
  2150.             :
  2151.  Skip prog name
  2152.  ?I%=Space% I%+=1:
  2153.             :
  2154.  Find start of arg
  2155. PrintIt%=
  2156. $I%,6)="-print"
  2157.  PrintIt% 
  2158. 4  I%+=6:
  2159.  ?I%=Space% I%+=1:
  2160.     :
  2161.  After -print
  2162.  ?I%<=Space% 
  2163. Load($I%,
  2164.  PrintIt% 
  2165. Print
  2166. Load(F$,Reset%)
  2167.  F%,T%
  2168.  "OS_File",17,F$ 
  2169.  F%,,T%:T%=T%>>8 
  2170.  &FFF
  2171.  F%<>1 
  2172. MT("NF")+": '"+F$+"'"
  2173.  T%=TextType% 
  2174. LoadNotes(F$):
  2175.  Reset% 
  2176. Mods(F$) 
  2177.  T%<>TreeType% 
  2178. NotOK(
  2179. MT("UF")) 
  2180. MT("CR")+" '"+F$+"'"
  2181. (F$):
  2182.  F%=0 
  2183.  -1,"dummy"
  2184. LoadError(F%,F$)
  2185.  Reset% 
  2186. Reset 
  2187.  Reset%=Root%!ObSubs%=0
  2188. GForce%=2                      :
  2189.  Main win to be redrawn & recentred
  2190.  "Hourglass_On"
  2191. Escape(
  2192. LoadGed(F%,Reset%)
  2193. Escape(
  2194.  "Hourglass_Off"
  2195.  Reset% 
  2196. SetFile(F$) 
  2197.  Modified%=
  2198. Goto(Person%)             :
  2199.  Set current person
  2200. LoadError(F%,F$)
  2201. Escape(
  2202. Reset
  2203. MT("BF")+": '"+F$+"' ("+
  2204. $+")"
  2205. Escape(On%)
  2206.  "OS_Byte",229,On%=0
  2207.  ============================= Save ===============================
  2208.  Save, Draw or Report chosen in the menu or dbox event
  2209. Save(WH%,IH%,But%)
  2210.  IB%,X0%,Y0%,P%,LP%,F$
  2211. IcTxt(WH%,SaIcFile%):F$=$P%:LP%=P%
  2212.  ?P%>31
  2213.  ?P%=
  2214. "." LP%=P%+1
  2215.   P%+=1
  2216. :$P%=""
  2217.  ember what we're saving
  2218.  WH%=SaveWH% SaveType%=TreeType% 
  2219.  WH%=RepoWH% SaveType%=ReportType% 
  2220.  SaveType%=DrawType%
  2221.  IH%=SaIcFile% 
  2222.  But%=CR% IH%=SaIcOK%
  2223.  IH% 
  2224.  SaIcCan%:
  2225. Close(WH%):
  2226.  "Wimp_CreateMenu",,-1:Menu%=0
  2227.  SaIcSprite%:
  2228.  But%>=16 SaveLeaf$=$LP%:
  2229. StartDrag(WH%)
  2230.  SaIcOK%
  2231.  F$=Scrap$ 
  2232. F$,".") 
  2233.      
  2234. SaveType(F$,
  2235.      
  2236. MouseMenu(WH%)
  2237.  Start dragging file sprite
  2238. StartDrag(WH%)
  2239. 1'!b%=WH%:
  2240.  "Wimp_GetWindowInfo",,b%
  2241. 2;IB%=b%+4+88+32*SaIcSprite%    :
  2242.  File sprite icon block
  2243. 30X0%=b%!4-b%!20:Y0%=b%!16-b%!24:
  2244.  Work origin
  2245. 4.b%!4=5                        :
  2246.  Fixed box
  2247. 5:b%!8=X0%+!IB%:b%!12=Y0%+IB%!4 :
  2248.  Screen coords of icon
  2249. b%!16=X0%+IB%!8
  2250. b%!20=Y0%+IB%!12
  2251. 8+b%!24=0:b%!28=0               :
  2252.  Limits
  2253. 9#b%!32=Infinity%:b%!36=Infinity%
  2254.  "Wimp_DragBox",,b%
  2255.  Drag for save done.  Send DataSave msg.
  2256. DragDone
  2257.  "Wimp_GetPointerInfo",,b%
  2258. A+mess%!12=0                    :
  2259.  My ref
  2260. B?mess%!16=DataSave             :
  2261.  I've got some data for you
  2262. C:mess%!20=b%!12:mess%!24=b%!16 :
  2263.  Window & icon handles
  2264. D(mess%!28=!b%:mess%!32=b%!4    :
  2265. E.mess%!36=0                    :
  2266.  File size
  2267. F.mess%!40=SaveType%            :
  2268.  File type
  2269. MessStr(mess%,44,SaveLeaf$)
  2270.  "Wimp_SendMessage",18,mess%,b%!12,b%!16
  2271.  Call the right routine to write the curent filetype
  2272. SaveType(F$,Safe%)
  2273.  SaveType% 
  2274.  TreeType%  :
  2275. SaveAs(F$,Safe%)
  2276.  TextType%  :
  2277. WriteNotes(F$)
  2278.  ReportType%:
  2279. Report(F$)
  2280.  DrawType%  :
  2281. WriteDraw(F$)
  2282.        :
  2283.  1,"PROCSaveType"
  2284.  "Wimp_CreateMenu",,-1:Menu%=0
  2285.  Save data to a temporary file in case write fails then rename as F$
  2286. SaveAs(F$,Safe%)
  2287.  F%,Temp$:Temp$=F$
  2288. SetPerson                 :
  2289.  Note current person
  2290. SetHeadTrlr
  2291.  F$<>Scrap$ 
  2292. Temp$,1)="="
  2293. MT("CC")+" ("+
  2294. $+")"
  2295. (Temp$)
  2296.  #F%:
  2297. MT("SF")+" ("+
  2298. $+")"
  2299.  "Hourglass_On"
  2300. Escape(
  2301. SaveSubs(F%,Root%,0)
  2302. Escape(
  2303.  "Hourglass_Off"
  2304.  Temp$<>F$ 
  2305. MT("CN")+" '"+F$+"' ("+
  2306. $+")"
  2307. DelFile(F$)             :
  2308.  Remove old F$
  2309.  "OS_FSControl",25,Temp$,F$ :
  2310.  Rename
  2311. SetFileType(F$,TreeType%)
  2312.  Safe% 
  2313. SetFile(F$)
  2314.  Set up HEAD and TRLR objects, preserving modification
  2315. SetHeadTrlr
  2316.  H%,Mod%,S%
  2317. Mod%=Modified%:H%=0
  2318. GetSub(Root%,HeadTg%,H%)=0 
  2319.   H%=
  2320. Object(HeadTg%,0)
  2321.   H%!ObNext%=Root%!ObSubs%
  2322.   Root%!ObSubs%=H%
  2323. SetStr(H%,SourTg%,"Acorn Archimedes !"+Task$,
  2324. }=  S%=0:
  2325. SetStr(
  2326. GetSub(H%,SourTg%,S%),VersTg%,Version$,
  2327. SetSub(H%,GedcTg%,0,
  2328. :  S%=0:
  2329. SetStr(
  2330. GetSub(H%,GedcTg%,S%),VersTg%,"5.3",
  2331. DelTag(Root%,TrlrTg%)        :
  2332.  Kill old trailer
  2333. SetSub(Root%,TrlrTg%,0,
  2334.  Ensure last
  2335. Modified%=Mod%
  2336. SaveSubs(F%,O%,Level%)
  2337. S%=O%!ObSubs%
  2338. SaveObj(F%,S%,Level%)
  2339. SaveSubs(F%,S%,Level%+1)
  2340.   S%=S%!ObNext%
  2341. SaveObj(F%,O%,Level%)
  2342.  T%,Val$
  2343. ,T%=O%!ObTag%:
  2344.  T%?TagFlags% 
  2345.  ProgTag% 
  2346. (Level%)+" ";
  2347.  Level%=0 
  2348. Id(O%)+" ";
  2349. TagStr(T%);
  2350. /Val$=
  2351. PrintStr(O%):
  2352.  Val$>"" 
  2353. #F%," "+Val$;
  2354. #F%,""
  2355. SetFile(F$)           :
  2356.  Now editing unmodified tree file F$
  2357.  Scrap$:
  2358.  ""    :TreeFile$="<"+
  2359. MT("UT")+">":F$=TreeLeaf$
  2360.   :TreeFile$=F$
  2361. IcTxt(SaveWH%,SaIcFile%)=F$
  2362. Modified%=
  2363. 8ModifiedShown%=
  2364.  Modified% :
  2365.  Force title bar redraw
  2366.  Write a report to text file F$
  2367. Report(F$)
  2368. MT("CC")+" ("+
  2369. $+")"
  2370.  #F%:
  2371. MT("SF")+" ("+
  2372. $+")"
  2373.  "Hourglass_On"
  2374. Escape(
  2375. WriteReport(F%)
  2376. Escape(
  2377.  "Hourglass_Off"
  2378. SetFileType(F$,ReportType%)
  2379.  F$<>Scrap$ $
  2380. IcTxt(RepoWH%,SaIcFile%)=F$
  2381. WriteReport(F%)
  2382.  CO%,FO%,Fam%,R%,S%
  2383.  Person%,ShowYearOnly%   :
  2384.  Override globals
  2385. ShowYearOnly%=
  2386. #F%,TreeFile$
  2387. Person%=0
  2388. GetSub(Root%,IndiTg%,Person%)
  2389. #F%,""
  2390. Name(Person%)+"  ("+
  2391. Dates(Person%)+")"
  2392. :  R%=
  2393. Father(Person%):
  2394. #F%,"  Father: "+
  2395. Name(R%)
  2396. :  R%=
  2397. Mother(Person%):
  2398. #F%,"  Mother: "+
  2399. Name(R%)
  2400.   Fam%=0
  2401. GetSub(Person%,FamsTg%,Fam%)
  2402.     FO%=
  2403. Val(Fam%)
  2404.     S%=
  2405. GetVal(FO%,HusbTg%)
  2406. 7    
  2407.  S%<>Person% 
  2408. #F%,"  Husband: "+
  2409. Name(S%)
  2410.     S%=
  2411. GetVal(FO%,WifeTg%)
  2412. 4    
  2413.  S%<>Person% 
  2414. #F%,"  Wife: "+
  2415. Name(S%)
  2416.     CO%=0
  2417. #    
  2418. GetSub(FO%,ChilTg%,CO%)
  2419. .      
  2420.  #F%,"    Child: "+
  2421. Name(
  2422. Val(CO%))
  2423.         
  2424. WriteNotesFile(F%,"  ")
  2425.  ======================== File Operations =========================
  2426. Modified              :
  2427.  Reflect modification in title bar
  2428.  ModifiedShown%=Modified% 
  2429.  Redraw title bar
  2430. %T$=TreeFile$:
  2431.  Modified% T$+=" *"
  2432. 4!b%=MainWH%:
  2433.  "Wimp_GetWindowInfo",,b% :
  2434.  blk@4
  2435. $b%!76=T$
  2436.  b%!32 
  2437.  1<<16 
  2438.  "Wimp_ForceRedraw",-1,b%!4,b%!16,b%!12,b%!16+44
  2439. ModifiedShown%=Modified%
  2440.  Return the length of File$ or -1 if not found
  2441. FileLen(File$)
  2442.  Found%,L%
  2443.  "OS_File",17,File$ 
  2444.  Found%,,,,L%
  2445.  Found%=1 
  2446. SetFileType(File$,Type%)
  2447.  "OS_File",18,File$,Type%
  2448.  Delete file F$ if it exists
  2449. DelFile(F$)
  2450.  "OS_File",6,F$
  2451.  ============================ GEDCOM ==============================
  2452.  Root% points to a level -1 pseudo-object.   Each object has a tag,
  2453.  a value, and a list of sub-objects.  Object values are initially
  2454.  pointers to strings but GEDCOM cross-references (Ids) are replaced
  2455.  by pointers to the referenced objects with the ObRef% bit set.
  2456.  Ids% points to a list of Ids.  Each Id has a pointer to the
  2457.  next Id, a pointer to the object it stands for, and a name.
  2458.  (Re)initialise everything, free all heap
  2459. Reset
  2460. SetFile("")
  2461. IcTxt(RepoWH%,SaIcFile%)=ReportLeaf$
  2462. IcTxt(DrawWH%,SaIcFile%)=DrawLeaf$
  2463. SetEdit(0)
  2464. ResetHeap
  2465. CFontM%!32=-1                  :
  2466.  Font menu heap pointer invalid
  2467. Close(NoteWH%)
  2468. NoteBuf%=0
  2469. InitHash :
  2470.  Hash table for looking up names
  2471. Root%=
  2472. Object(RootTg%,0)
  2473. Person%=0
  2474. Force%=1
  2475.  Load objects from a file and build a heirarchy under R%.  If loading
  2476.  into an empty database (Reset%<>0) then R% is Root% otherwise add
  2477.  the new objects under a temporary root R% and then merge into Root%.
  2478. LoadGed(F%,Reset%)
  2479.  Id%,Id$,Level%,O%,R%,SubTl%(),Tag$,Value$,T%
  2480.  Where to hang next object at each level.  Root object is level -1.
  2481.  SubTl%(MaxLevel%):SubTl%()=0
  2482. CIds%=0                        :
  2483.  No inter-file cross references
  2484.  Reset% R%=Root% 
  2485. Object(RootTg%,0)
  2486. SubTl%(0)=
  2487. Tail(R%)
  2488.  Skip to header
  2489. #F%="0 HEAD" 
  2490. #F%=0 
  2491. #F%=O%
  2492. GedLine(F%,Level%,Id$,Tag$,Value$)
  2493.  Level%>=0 
  2494. .    O%=
  2495. Object(
  2496. Tag(Tag$),
  2497. String(Value$))
  2498.      6    SubTl%(Level%+1)=O%+ObSubs%:SubTl%(Level%+2)=0
  2499.     !8    T%=SubTl%(Level%):
  2500.  T%=0 
  2501. MT("BL")+": "+$b%
  2502.     "(    !T%=O%:SubTl%(Level%)=O%+ObNext%
  2503.  Id$>"" 
  2504.     $9      Id%=
  2505. Alloc(IdName%+
  2506. (Id$)+1):$(Id%+IdName%)=Id$
  2507.     %1      Id%!IdNext%=Ids%:Id%!IdObj%=O%:Ids%=Id%
  2508.     &        
  2509. XRef(R%)
  2510.  Ids%:
  2511. Free(Ids%):Ids%=Ids%!IdNext%:
  2512.  Free ids
  2513.  Reset% 
  2514. Merge(R%):
  2515. Free(R%)
  2516. FindPerson
  2517.  Merge New%'s sub-objects into Root%'s.  INDIs
  2518.  are sorted in by name, others are appended.
  2519. Merge(New%)
  2520.  E%,O%,N%,P%
  2521.  Find tail of Root%'s subs
  2522. Tail(Root%)
  2523. O%=New%!ObSubs%
  2524.   N%=O%!ObNext%
  2525.     92  
  2526.  O%!ObTag%=IndiTg% P%=
  2527. Position(O%) 
  2528.  P%=E%
  2529.   O%!ObNext%=!P%:!P%=O%
  2530.  P%=E% E%=O%+ObNext%
  2531.   O%=N%
  2532. GedLine(F%,
  2533.  Level%,
  2534.  Id$,
  2535.  Tag$,
  2536.  Value$)
  2537.  I%,P%
  2538. #F%:P%=b%
  2539. White(?P%):P%+=1:
  2540.  ?P%=CR% Level%=-1:
  2541.  Ignore empty line
  2542.     E/Level%=
  2543. ($P%)               :
  2544.  Level number
  2545.  Level%=0 
  2546.     G-  
  2547. Digit($P%) 
  2548. MT("ML")+": "+$b%
  2549.     H/  
  2550.  "Hourglass_Percentage",100*
  2551.  Level%>MaxLevel% 
  2552. MT("BL")+": "+$b%
  2553.  Strip trailing spaces
  2554.     L2I%=P%+
  2555. ($P%)-1:
  2556. White(?I%):I%-=1:
  2557. :I%?1=CR%
  2558.     M/I%=
  2559. $P%," "):
  2560.  I%=0 
  2561. MT("MG")+": "+$b%
  2562.     N5P%+=I%                        :
  2563.  Optional xref id
  2564.  ?P%=
  2565.   P%+=1:I%=
  2566. $P%,"@")
  2567.     Q$  
  2568.  I%=0 
  2569. MT("BC")+": "+$b%
  2570.   Id$=
  2571. $P%,I%-1)
  2572.     S5  P%+=I%                      :
  2573.  After trailing @
  2574.  Id$=""
  2575.  ?P%=Space% P%+=1           :
  2576.  (Not really) optional delimiter
  2577.     W4I%=
  2578. $P%," ")             :
  2579.  Delimiter after tag?
  2580.  I% Tag$=
  2581. $P%,I%-1) 
  2582.  Tag$=$P%:I%=
  2583. (Tag$)
  2584.     Y8Value$=$(P%+I%)               :
  2585.  Optional line items
  2586. White(C%)=C%=Tab% 
  2587.  C%=LF% 
  2588.  C%=Space%
  2589. Lower($mess%)
  2590.  P%:P%=mess%
  2591.  ?P%<>CR%
  2592.  ?P%>=
  2593.  ?P%<=
  2594. "z" ?P%=?P% 
  2595.     b    P%+=1
  2596. =$mess%
  2597.  Convert a pointer to a cross-ref id.
  2598.  Just use its word offset into the heap.
  2599. Id(V%)="@"+
  2600. ((V%-Heap%)>>2)+"@"
  2601.  Set Person% to the person named in a level 0 NOTE or the last INDI
  2602. FindPerson
  2603.  O%,Val$
  2604. O%=Root%!ObSubs%
  2605.  O%!ObTag% 
  2606.  IndiTg%:Person%=O%
  2607.  NoteTg%
  2608.     Val$=
  2609. Null(O%!ObVal%)
  2610.     u5    
  2611. Val$,6)="Person" Person%=
  2612. Find(
  2613. Val$,8)):
  2614.   O%=O%!ObNext%
  2615.  Call PROCDeref for O% and its sub-objects recursively
  2616. XRef(O%)
  2617. Deref(O%)
  2618. 1O%=O%!ObSubs%:
  2619. XRef(O%):O%=O%!ObNext%:
  2620.  If O%'s value string is a GEDCOM pointer @id@ then
  2621.  replace it with a pointer to the object with that Id.
  2622. Deref(O%)
  2623.  S$,Val%,Target%
  2624. Val%=O%!ObVal%:
  2625.  Val%=0 
  2626.  ?Val%<>
  2627. S$=$(Val%+1)
  2628. S$,1)<>"@" 
  2629.  Target%=
  2630. IdObj(
  2631. (S$)-1))
  2632.  Target%=0 
  2633.  1,"Bad cross-reference "+$Val%
  2634. Free(Val%)
  2635. 5O%!ObVal%=Target% 
  2636.  ObRef%   :
  2637.  Flag as reference
  2638.  Return the object with Id$
  2639. IdObj(Id$)
  2640.  I%:I%=Ids%
  2641.  Id$="" 
  2642.  1,"FNIdObj"
  2643.  $(I%+IdName%)=Id$ 
  2644. =I%!IdObj%
  2645.   I%=I%!IdNext%
  2646. Error:=0
  2647. MT("BC")+": "+Id$
  2648.  ========================= GEDCOM edit ============================
  2649.  Create a window to display and edit all GEDCOM fields.
  2650.  (Under construction).  
  2651. ObjEdit
  2652. +!b%=ObEdWH%:
  2653.  "Wimp_GetWindowInfo",,b%
  2654. /y%=b%!56                      :
  2655.  Work max y
  2656. OERecurse(Root%,-1,0,y%,-Infinity%,-Infinity%)
  2657. b%!48=y%-8
  2658.  "Wimp_DeleteWindow",,b%
  2659.  "Wimp_CreateWindow",,b%+4 
  2660.  ObEdWH%
  2661. Open(ObEdWH%)
  2662. DrawObEd(XW%,YW%,YMin%,YMax%)
  2663. YW%-=8
  2664. OERecurse(Root%,-1,XW%+8,YW%,YMin%-CharH%,YMax%+CharH%)
  2665. ObEdClick(Y%)
  2666.  YW%,S%
  2667. ,!b%=ObEdWH%:
  2668.  "Wimp_GetWindowState",,b%
  2669. YW%=b%!16-b%!24
  2670. OERecurse(Root%,-1,0,YW%,Y%+8,-Infinity%)
  2671.  S%=0 
  2672.  ?? PROCD(FNTagStr(S%!ObTag%))
  2673.  If YW%<YMax% then draw object S%.  Update YW%.
  2674.  If YW%<Ymin% then return S% else recurse on S%'s
  2675.  subobjects.  Return 0 to continue the recusion.
  2676. OERecurse(S%,Depth%,XW%,
  2677.  YW%,YMin%,YMax%)
  2678.  F%,T%,X%,L$
  2679.  T%=S%!ObTag%:F%=T%?TagFlags%
  2680.  S%<>Root% 
  2681.  ProgTag% 
  2682.  YW%<YMax% 
  2683.  XW%>=0 X%=XW%:
  2684.  Depth%>0 X%+=2*Depth%*CharW%
  2685.  Depth%=0 
  2686.  X%,YW%:
  2687. Id(S%);
  2688.  X%+8*CharW%,YW%:
  2689. TagStr(T%);" ";
  2690. PrintStr(S%)
  2691.  YW%-=CharH%:
  2692.  YW%<YMin% 
  2693. S%=S%!ObSubs%
  2694. >  X%=
  2695. OERecurse(S%,Depth%+1,XW%,YW%,YMin%,YMax%):
  2696.   S%=S%!ObNext%
  2697.  ============================= Tags ===============================
  2698.  Return the (new) tag with name T$
  2699. Tag(T$)
  2700.  T%:T%=Tags%
  2701.  $(T%+TagName%)=T$ 
  2702.   T%=T%!TagNext%
  2703. MkTag(T$)
  2704. MkTag(T$)
  2705.  T% TagName%+
  2706. (T$)+1
  2707. T%?TagFlags%=0
  2708. T%!TagNext%=Tags%
  2709. $(T%+TagName%)=T$
  2710. Tags%=T%
  2711. TagStr(T%)=$(T%+TagName%)
  2712.  Initialise tags structures and linked list
  2713. InitTags
  2714.  A tag is a pointer to a structure consisting of
  2715. 5TagNext% =0                   :
  2716.  Next tag pointer
  2717. C                              :
  2718.  Other fields, e.g. help string
  2719. .TagFlags%=4                   :
  2720.  Flag byte
  2721. CTagName% =5                   :
  2722.  Variable length, CR terminated
  2723. 9Tags%=0                       :
  2724.  Pointer to first tag
  2725.  Tag flags
  2726. DProgTag%=1                    :
  2727.  Program only object - not saved
  2728.  Flag for PROCMark, PROCScan stored in object's tag pointer
  2729. Dead%=1
  2730.  Create tags used explicitly by code
  2731. HeadTg%=
  2732. MkTag("HEAD")
  2733. SourTg%=
  2734. MkTag("SOUR")
  2735. VersTg%=
  2736. MkTag("VERS")
  2737. GedcTg%=
  2738. MkTag("GEDC")
  2739. TrlrTg%=
  2740. MkTag("TRLR")
  2741. IndiTg%=
  2742. MkTag("INDI")
  2743. NameTg%=
  2744. MkTag("NAME")
  2745. SexTg%= 
  2746. MkTag("SEX" )
  2747. DateTg%=
  2748. MkTag("DATE")
  2749. BirtTg%=
  2750. MkTag("BIRT")
  2751. DeatTg%=
  2752. MkTag("DEAT")
  2753. FamTg%= 
  2754. MkTag("FAM" )
  2755. NoteTg%=
  2756. MkTag("NOTE")
  2757. ContTg%=
  2758. MkTag("CONT")
  2759. FamsTg%=
  2760. MkTag("FAMS")
  2761. FamcTg%=
  2762. MkTag("FAMC")
  2763. HusbTg%=
  2764. MkTag("HUSB")
  2765. WifeTg%=
  2766. MkTag("WIFE")
  2767. ChilTg%=
  2768. MkTag("CHIL")
  2769.  ProgTag% objects are for internal use only
  2770. 6RootTg%=
  2771. MkTag("root"):RootTg%?TagFlags%+=ProgTag%
  2772.  Display structure pointer
  2773. 6DispTg%=
  2774. MkTag("disp"):DispTg%?TagFlags%+=ProgTag%
  2775.  ============================ Syntax ==============================
  2776.  Load GEDCOM syntax description ??
  2777. Syntax
  2778.  F%,F$
  2779. F$="<Family$Dir>.GEDSyn"
  2780. (F$):
  2781.  F%=0 
  2782. MT("CR")+" "+F$
  2783.   $b%=
  2784.  ?b% 
  2785. "#",CR%:
  2786.  Ignore comments and blank lines
  2787.  Print name
  2788.  Help string
  2789.  sub-objects
  2790.  ============================= Print ==============================
  2791. Print
  2792.  F%,OldJob%,Page%,More%,x%,y%,dx%,dy%,N%
  2793.  Left%,Bottom%,Right%,Top%,Height%,Width%
  2794.  Following locals override PROCdisplay global work origin
  2795.  XW%,YW%:XW%=0:YW%=0
  2796.  Error handler must be local so we can restore the old one
  2797.  Person%=0 
  2798. MT("NP")
  2799. OldJob%=-1:F%=0
  2800. PrintErr
  2801. ("Printer:")
  2802.  "PDriver_SelectJob",F%,"Tree" 
  2803.  OldJob%
  2804.  "PDriver_Info" 
  2805. ,,,N%
  2806.  1<<29 
  2807.  "PDriver_DeclareFont",,Font$
  2808.  "PDriver_DeclareFont"
  2809.  Get printable paper area limits in millipoints
  2810.  "PDriver_PageSize" 
  2811. ,,,Left%,Bottom%,Right%,Top%
  2812.  Size in OS units.  1 OS unit = 400 millipoints = 1/180".
  2813. <HWidth%=(Right%-Left%) 
  2814.  mPtPerOS%:Height%=(Top%-Bottom%) 
  2815.  mPtPerOS%
  2816.  Rotate% 
  2817.  Width%,Height%
  2818. >AUseFont%=
  2819. CalcAll     :
  2820.  Recalculate positions for printing
  2821. ?BForce%=1                      :
  2822.  Set to recalculate for screen
  2823. @@Page%=1                       :
  2824.  Identify rectangle to print
  2825.  Work area is (0,yMin%)..(xMax%,0).  Allow overlap between pages
  2826. B N%=(xMax%+Width%-1) 
  2827.  Width%
  2828.  N%>1 dx%=(xMax%-Width%) 
  2829.  (N%-1) 
  2830.  dx%=Width%
  2831. D#N%=(-yMin%+Height%-1) 
  2832.  Height%
  2833.  N%>1 dy%=(-yMin%-Height%) 
  2834.  (N%-1) 
  2835.  dy%=Height%
  2836.  "Hourglass_On"
  2837.  y%=yMin% 
  2838.  0-Height% 
  2839.  dy%:
  2840.  x%=0 
  2841.  xMax%-Width% 
  2842.  Set work rectangle to print at b% in OS units.  Top left = (0,0).
  2843. I5  b%!0=x%:b%!4=y%:b%!8=x%+Width%:b%!12=y%+Height%
  2844.  Set transform table at b%+16.  x'=(ax+cy)>>16  y'=(bx+dy)>>16
  2845.  Print position of transformed bottom left at b%+32 in millipoints.
  2846.  Seascape (clockwise) is more natural than landscape (anticlockwise)
  2847.  for continuous paper since x=0 will be at the top.
  2848.  Rotate% 
  2849. OH    b%!16=0:b%!20=-1<<16:b%!24=1<<16:b%!28=0  :
  2850.  Seascape x'=y y'=-x
  2851. PH    b%!32=Left%:b%!36=Top%                    :
  2852.  Rotate 90 clockwise
  2853. RI    b%!16=1<<16:b%!20=0:b%!24=0:b%!28=1<<16   :
  2854.  Portrait  x'=x  y'=y
  2855. S@    b%!32=Left%:b%!36=Bottom%                 :
  2856.  No rotation
  2857.  "PDriver_GiveRectangle",Page%,b%,b%+16,b%+32,White%
  2858.  "PDriver_DrawPage",1,b%,Page%,
  2859. (x%)+","+
  2860.  More%
  2861.  More%
  2862. XL    
  2863. Display(b%!0,b%!4,b%!8,b%!12,OutPrint%) :
  2864.  b% is work rect to print
  2865. Y-    
  2866.  "PDriver_GetRectangle",,b% 
  2867.  More%
  2868.   Page%+=1
  2869.  "Hourglass_Off"
  2870.  "PDriver_EndJob",F%
  2871.  "PDriver_SelectJob",OldJob%
  2872. PrintErr
  2873.  OldJob%>=0 
  2874.  "PDriver_AbortJob",F%
  2875.  "PDriver_SelectJob",OldJob%
  2876.  "Hourglass_Smash"
  2877.  ========================= Write Draw file ========================
  2878. WriteDraw(F$)
  2879.  XW%,YW%                 :
  2880.  Override PROCdisplay global work origin
  2881.  "Hourglass_On"
  2882. dw_open(F$)               :
  2883.  open draw file
  2884. dw_font(Font$)            :
  2885.  set up font
  2886. t@UseFont%=
  2887. CalcAll     :
  2888.  Recalculate positions for drawing
  2889. uBForce%=1                      :
  2890.  Set to recalculate for screen
  2891.  Draw with bottom left = 0,0 in infinite clip rectangle
  2892. XW%=-xMin%:YW%=-yMin%
  2893. Display(-Infinity%,-Infinity%,Infinity%,Infinity%,OutDraw%)
  2894. dw_close
  2895.  F$<>Scrap$ $
  2896. IcTxt(DrawWH%,SaIcFile%)=F$
  2897.  "Hourglass_Off"
  2898.  Open draw file and initialise variables
  2899. dw_open(fnam$)
  2900.  dw_fh%=
  2901. (fnam$):
  2902.  dw_fh%=0 
  2903. dw_file$=fnam$
  2904.  Initialise bounding box and font
  2905. (dw_xmn%=Infinity%:dw_xmx%=-Infinity%
  2906. (dw_ymn%=Infinity%:dw_ymx%=-Infinity%
  2907. 0dw_ft%=0                      :
  2908.  System font
  2909.  Write header
  2910. #dw_fh%,"Draw";:
  2911. dw_word(201):
  2912. dw_word(0)
  2913. #dw_fh%,"Family      ";   :
  2914.  Name must be 12 characters
  2915. #dw_fh%=40                 :
  2916.  Skip bounding box for now
  2917.  Terminate and close file
  2918. dw_close
  2919.  dw_fh%=0 
  2920. #dw_fh%=24                 :
  2921.  Output bounding box
  2922. dw_cd(dw_xmn%,dw_ymn%):
  2923. dw_cd(dw_xmx%,dw_ymx%)
  2924. #dw_fh%:dw_fh%=0         :
  2925.  Close draw file
  2926. SetFileType(dw_file$, DrawType%)
  2927.  Make font object
  2928. dw_font(font$)
  2929.  dw_fh%=0 
  2930. dw_word(0)                  :
  2931.  Object type 0
  2932. dw_word((
  2933. (font$)+13)
  2934.  Length
  2935. dw_ft%=1
  2936. #dw_fh%,dw_ft%
  2937. dw_string(font$)
  2938.  Draw some text
  2939. dw_text(x1%,y1%,size%,colour%,text$)
  2940.  dw_fh%=0 
  2941.  "Font_SetFont",Font%
  2942.  "Font_StringBBox",,text$ 
  2943. ,xx1%,yy1%,xx2%,yy2%
  2944. Ax2%=x1%+(xx2%-xx1%)
  2945.  mPtPerOS%:y2%=y1%+(yy2%-yy1%)
  2946.  mPtPerOS%
  2947. dw_word(1)                :
  2948.  Object type 1
  2949. dw_word((
  2950. (text$)+56)
  2951.  Length
  2952. dw_bx                     :
  2953.  4 words of bounding box
  2954. dw_word(colour%)          :
  2955.  Text colour
  2956. dw_word(&FFFFFF00)        :
  2957.  Background colour
  2958. dw_word(dw_ft%)           :
  2959.  Font
  2960. dw_word(size%*640*DrawScale):
  2961.  Nominal size of font
  2962. dw_word(size%*640*DrawScale)
  2963. dw_cd(x1%,y1%)            :
  2964.  Start coords
  2965. dw_string(text$)
  2966.  Output a null-terminated string.  Pad to word boundary.
  2967. dw_string(S$)
  2968. #dw_fh%,S$;
  2969.  P%:P%=
  2970. #dw_fh% 
  2971. #dw_fh%,0:P%+=1:
  2972.  P%=4
  2973.  Draw a line
  2974. dw_line(x1%,y1%,x2%,y2%,colour%)
  2975.  dw_fh%=0 
  2976. dw_word(2)                :
  2977.  Object type 2
  2978. dw_word(68)               :
  2979.  Length
  2980. dw_bx                     :
  2981.  4 words of bounding box
  2982. dw_word(-1)               :
  2983.  No fill
  2984. dw_word(colour%)
  2985. dw_word(DrawWidth%)
  2986. dw_word(0)                :
  2987.  Style
  2988. dw_word(2)                :
  2989.  Move
  2990. dw_cd(x1%,y1%)            :
  2991.  Start coords
  2992. dw_word(8)                :
  2993.  DRAW
  2994. dw_cd(x2%,y2%)            :
  2995.  Start coords
  2996. dw_word(0)                :
  2997.  End path
  2998.  Output bounding box x1%,y1% - x2%,y2%
  2999. dw_bx
  3000.  xx1%,yy1%,xx2%,yy2%
  3001. 'xx1%=x1%:yy1%=y1%:xx2%=x2%:yy2%=y2%
  3002.  xx1%>xx2% 
  3003.  xx1%,xx2%
  3004.  yy1%>yy2% 
  3005.  yy1%,yy2%
  3006. dw_cd(xx1%,yy1%):
  3007. dw_cd(xx2%,yy2%)
  3008.  Update overall box
  3009. Min(dw_xmn%,xx1%):
  3010. Min(dw_ymn%,yy1%)
  3011. Max(dw_xmx%,xx2%):
  3012. Max(dw_ymx%,yy2%)
  3013.  Output coordinate pair.  Convert from OS
  3014.  coords (1/180") to draw units (1/(180*256)").
  3015. dw_cd(X%,Y%)
  3016. dw_word((X%<<8)*DrawScale):
  3017. dw_word((Y%<<8)*DrawScale)
  3018.  Output word
  3019. dw_word(word%)
  3020. #dw_fh%,word%:
  3021. #dw_fh%,word%>>8
  3022. #dw_fh%,word%>>16:
  3023. #dw_fh%,word%>>24
  3024.  ==================== Low-level memory allocation =================
  3025.  Free% points after last block allocated or at lowest freed.  Block
  3026.  starts with 4-byte count of following bytes.  Count is multiple
  3027.  of 4.  Bit 0 => block in use.  Coalesce as much as possible on
  3028.  allocation.  Only zero size block is last block.  Musn't leave a
  3029.  zero size block when allocating part of a block.  HeapFree% is
  3030.  total free space including count words of free blocks.
  3031. ResetHeap
  3032. HeapSize%=HeapEnd%-Heap%
  3033. 6HeapLow%=0.05*HeapSize%       :
  3034.  Warn if less free
  3035. >!Heap%=HeapSize%-8            :
  3036.  8 bytes = two count words
  3037. ?Heap%!(HeapSize%-4)=0         :
  3038.  End marker: no bytes, free
  3039. Free%=Heap%
  3040. HeapFree%=HeapSize%
  3041. @HeapWarn%=HeapLow%            :
  3042.  Warn if less than this free
  3043. Alloc(W%)
  3044.  E%,N%,S%,B%
  3045.  W%=0 
  3046. W%=(W%+3) 
  3047. B%=Free%
  3048. 3  S%=!B% 
  3049.  1             :
  3050.  Size of cur block
  3051.  S%=0 
  3052. MT("OM")
  3053. 0  N%=B%+4+S%                   :
  3054.  Next block
  3055.  (!B% 
  3056.  1)>0           :B%=N%:S%=0
  3057.  (!N% 
  3058.  1)=0 
  3059.  !N%<>0:!B%+=!N%+4:S%=0
  3060.  S%<W%                   :B%=N%
  3061.  S%=W%                   :Free%=N%
  3062.  S%>W%                   :E%=S%-W%-4
  3063. 1    
  3064.  E% Free%=B%+4+W%:!Free%=E% 
  3065.  B%=N%:S%=0
  3066.  S%>=W%
  3067. !B%=W% 
  3068. HeapFree%-=W%+4
  3069.     =B%+4
  3070.  Free block at A%.  Freeing any number of
  3071.  objects will not disturb their contents.
  3072. Free(A%)
  3073.  A%=0 
  3074.     A%-=4
  3075.  (!A% 
  3076.  1)=0 
  3077.  1,"PROCFree not heap"
  3078.  (!A% 
  3079.  1)=0 
  3080.  1,"PROCFree size 0"
  3081. !A%-=1
  3082.  A%<Free% Free%=A%
  3083. HeapFree%+=!A%
  3084.  Free old block O% and copy (some of)
  3085.  its contents to a new one of size S%
  3086.  DEF PROCRealloc(RETURN O%,S%)
  3087.  LOCAL I%,N%
  3088.  S%=(S%+3) AND NOT 3
  3089.  N%=FNAlloc(S%)
  3090.  IF O%=0 O%=N%:ENDPROC
  3091.  PROCMin(S%,FNSize(O%))
  3092.  FOR I%=0 TO S%-1 STEP 4:N%!I%=O%!I%:NEXT
  3093.  PROCFree(O%)
  3094.  O%=N%
  3095.  ENDPROC
  3096.  Make a heap copy of string S$.  An empty string
  3097.  is not stored, it is replaced by null pointers.
  3098. String(S$)
  3099.  S$="" 
  3100. Alloc(
  3101. (S$)+1)
  3102. $A%=S$
  3103.  DEF FNSize(A%)
  3104.  IF A%=0 ERROR 1,"FNSize"
  3105.  =A%!-4 AND NOT 1
  3106. CheckFree
  3107. (HeapFree% 
  3108.  1024)
  3109.  $BarIcText%<>K$ 
  3110. @(  b%!0=-1:b%!4=BarIc%:b%!8=0:b%!12=0
  3111.   $BarIcText%="    "
  3112.  "Wimp_SetIconState",,b%
  3113.   $BarIcText%=K$
  3114.  "Wimp_SetIconState",,b%
  3115.  HeapFree%>HeapWarn% 
  3116. G<HeapWarn%=-1 :
  3117.  Inhibit warning until next PROCResetHeap
  3118. MT("MW")
  3119.  ============================ Choices =============================
  3120.  Set default choices and load from file
  3121. LoadOpts
  3122.  F%,L$,K$,V$
  3123.  Font$,PtSize% is the font used for printing
  3124. R@Font$="Trinity.Medium":PtSize%=10   :
  3125.  Like Postscript Times
  3126.  Font$="System.Fixed":PtSize%=12 :REM Looks just like system font
  3127.  Should the above font be used on screen as well?
  3128. ScreenUseFont%=
  3129.  Should person's family name be shown if same as father's?
  3130. ShowFamilyName%=
  3131.  Should dates be shown?
  3132. ShowDates%=
  3133.  Should only year be shown?
  3134. ShowYearOnly%=
  3135.  Print rotated?
  3136. Rotate%=
  3137.  Draw scale
  3138. DrawScale=1.0
  3139.  Draw line width
  3140. DrawWidth%=4
  3141. (OptFile$)
  3142.     L$=
  3143. KeyVal(L$,K$,V$)
  3144. i#    
  3145.  "Font"          :Font$=V$
  3146. j(    
  3147.  "PointSize"     :PtSize%=
  3148. k/    
  3149.  "ScreenUseFont" :ScreenUseFont%=
  3150. l0    
  3151.  "ShowFamilyName":ShowFamilyName%=
  3152. m+    
  3153.  "ShowDates"     :ShowDates%=
  3154. n.    
  3155.  "ShowYearOnly"  :ShowYearOnly%=
  3156. o=    
  3157.  Accept "Landscape" for v2.02 backward compatibility
  3158. p,    
  3159.  "Landscape","Rotate":Rotate%=
  3160. q*    
  3161.  "DrawScale"     :DrawScale=
  3162. r+    
  3163.  "DrawWidth"     :DrawWidth%=
  3164. s        
  3165. FindFont(Font$,PtSize%)
  3166. KeyVal(Line$,
  3167.  Key$,
  3168.  Val$)
  3169. Line$,":")
  3170. Key$=
  3171. Line$,I%-1)
  3172.  I%=0 
  3173. Key$," ") Key$="":Val$="":
  3174.  I%+=1:
  3175. Line$,I%,1)<>" "
  3176. Val$=
  3177. Line$,I%)
  3178. SaveOpts
  3179. (OptFile$)
  3180. #F%,"Font:"+Font$
  3181. #F%,"PointSize:"+
  3182.  PtSize%
  3183. #F%,"ScreenUseFont:"+
  3184.  ScreenUseFont%
  3185. #F%,"ShowFamilyName:"+
  3186.  ShowFamilyName%
  3187. #F%,"ShowDates:"+
  3188.  ShowDates%
  3189. #F%,"ShowYearOnly:"+
  3190.  ShowYearOnly%
  3191. #F%,"Rotate:"+
  3192.  Rotate%
  3193. #F%,"DrawScale:"+
  3194.  DrawScale
  3195. #F%,"DrawWidth:"+
  3196.  DrawWidth%
  3197.  Set up choices menu
  3198. ShowOpts
  3199.  M%,MenuLen%,IndLen%
  3200.  "Font_ListFonts",,,1<<19 
  3201.  1<<21 
  3202. ,,,MenuLen%,,IndLen%
  3203.  FontM%!32 points to font name submenu+indirect data if > 0
  3204. !M%=FontM%!32:
  3205.  M%>0 
  3206. Free(M%)
  3207. Alloc(MenuLen%+IndLen%)
  3208.  "Font_ListFonts",,M%,1<<19 
  3209.  1<<21,MenuLen%,M%+MenuLen%,IndLen%,Font$
  3210. FontM%!32=M%
  3211. $FontSizeBuf%=
  3212. (PtSize%)+
  3213. SelEntry(FontM%,2,ScreenUseFont%)
  3214. SelEntry(FontM%,3,Rotate%)
  3215. SelEntry(ShowM%,0,ShowFamilyName%)
  3216. SelEntry(ShowM%,1,ShowDates%)
  3217. SelEntry(ShowM%,2,ShowYearOnly%)
  3218. "$DrawScaleBuf%=
  3219. (DrawScale)+
  3220. #$DrawWidthBuf%=
  3221. (DrawWidth%)+
  3222.  Event in choices menu
  3223. SetOpts(Choice1%,Choice2%,Choice3%,But%)
  3224.  F%,F$
  3225.  Choice1% 
  3226.  0                        :
  3227.  Font
  3228.  Choice2% 
  3229.  Decode font id into mess% and copy to F$
  3230. K         
  3231.  "Font_DecodeMenu",,FontM%!32,b%+12,mess%,messlen% 
  3232. ,,,F$,F%
  3233. 0         
  3234. FindFont(F$,PtSize%):Force%=1
  3235.  1:F%=
  3236. ($FontSizeBuf%)
  3237. )         
  3238. FindFont(Font$,F%):Force%=1
  3239.  2:ScreenUseFont%=
  3240.  ScreenUseFont%
  3241.          Force%=1
  3242.  3:Rotate%=
  3243.  Rotate%
  3244.  1                        :
  3245.  Show
  3246.  Choice2% 
  3247.  0:ShowFamilyName%=
  3248.  ShowFamilyName%
  3249.  1:ShowDates%=
  3250.  ShowDates%
  3251.  2:ShowYearOnly%=
  3252.  ShowYearOnly%
  3253.   Force%=1
  3254.  2                        :
  3255.  Draw
  3256.  Choice2% 
  3257.  0:DrawScale=
  3258. ($DrawScaleBuf%)
  3259.  1:DrawWidth%=
  3260. ($DrawWidthBuf%)
  3261. SaveOpts
  3262. FindFont(F$,S%)
  3263.  O%:O%=Font%
  3264.  "Font_ReadScaleFactor" 
  3265. ,mPtPerOS%
  3266.  "Font_FindFont",,F$,16*S%,16*S% 
  3267.  Font%
  3268.  "Font_LoseFont",O%
  3269. Font$=F$:PtSize%=S%
  3270.  ========================== MessageTrans ==========================
  3271. MTLoad(MTFile$)
  3272.  MTB%
  3273.  "OS_Module",6,,,17+
  3274. (MTFile$) 
  3275. ,,MTFile% :
  3276.  Allocate RMA
  3277. $(MTFile%+16)=MTFile$
  3278.  MTB% 
  3279. FileLen(MTFile$)
  3280.  "MessageTrans_OpenFile",MTFile%,MTFile%+16,MTB%
  3281.  Look up a token in the Messages file.  No substitution allowed.
  3282. MT(Tok$)
  3283.  L%,R%
  3284.  "MessageTrans_Lookup",MTFile%,Tok$ 
  3285. ,,R%,L%
  3286. $(R%+L%)=""
  3287.  ========================== Quit & error ==========================
  3288. Mods(".Q") 
  3289. ExtEdAbort
  3290.  Font% 
  3291.  "Font_LoseFont",Font%
  3292.  Task% $b%="TASK":
  3293.  "Wimp_CloseDown",Task%,!b%
  3294.  Errors < 0 are expected - retain error handler and return.
  3295.  Error 0 is untrappable so won't be passed here.
  3296.  Errors > 0 are fatal - cancel error handler and quit.
  3297. Error
  3298.  At$,R%
  3299. >0 At$=" at line "+
  3300. +"!" 
  3301.  At$=""
  3302. :$(b%+4)=
  3303. $+At$+
  3304.  "Wimp_ReportError",b%,(
  3305.  1,Task$ 
  3306.  R%=2 
  3307. NotOK(Query$)
  3308. "!mess%=-1:$(mess%+4)=Query$+
  3309.  "Wimp_ReportError",mess%,&13,Task$ 
  3310. 2=R%=2                         :
  3311.  Cancel button
  3312.  If data modified open the "modified data" dbox
  3313.  and suspend the current load, reset or quit.
  3314.  Remember what to do if the user hits "Discard".
  3315. Mods(F$)
  3316.  Modified% ToDo$=F$:
  3317. MouseMenu(ModsWH%)
  3318. =Modified%
  3319. D(A$)
  3320.  B%,J%
  3321.  A$="" Debug%=0:
  3322.  "PDriver_SelectJob",0,0 
  3323.  4,26:
  3324. 0,1);A$;".":
  3325.  "PDriver_SelectJob",J%
  3326. Debug%=(Debug%+1) 
  3327.  "Hourglass_Smash":
  3328.  "OS_Confirm"
  3329.  z%,z%,B%:
  3330.  B%=0
  3331.  z=INKEY(100)
  3332.